blob: b6fef381d1268cbebe86a0d6f4fc0de29d89744e [file] [log] [blame]
PROGRAM FM104
C COMMENT SECTION. 00010104
C 00020104
C FM104 00030104
C 00040104
C THIS ROUTINE IS A TEST OF THE / FORMAT AND IS TAPE AND PRINTER00050104
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060104
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070104
C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080104
C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090104
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100104
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110104
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120104
C INTEGER ARRAY FOR THE DUMP SECTION. 00130104
C 00140104
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150104
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00160104
C CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS 00170104
C AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED. 00180104
C 00190104
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00200104
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00210104
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00220104
C OF THE CONTINUATION LINE. 00230104
C 00240104
C REFERENCES 00250104
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260104
C X3.9-1978 00270104
C 00280104
C SECTION 8, SPECIFICATION STATEMENTS 00290104
C SECTION 9, DATA STATEMENT 00300104
C SECTION 11.10, DO STATEMENT 00310104
C SECTION 12, INPUT/OUTPUT STATEMENTS 00320104
C SECTION 12.8.2, INPUT/OUTPUT LIST 00330104
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00340104
C SECTION 13, FORMAT STATEMENT 00350104
C SECTION 13.2.1, EDIT DESCRIPTORS 00360104
C SECTION 13.5.9.1, INTEGER EDITING 00370104
C 00380104
COMMON ITEST(7), IACN11(57), ICHEC 00390104
C 00400104
DIMENSION IPREM(7), IADN11(57) 00410104
DIMENSION IDUMP(136) 00420104
CHARACTER*1 NINE,IZERO,IDUMP 00430104
DATA NINE/'9'/, IZERO/'0'/ 00440104
C 00450104
77701 FORMAT ( 80A1 ) 00460104
77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00470104
1F ",I3," RECORDS") 00480104
77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00490104
77704 FORMAT (10X,"FILE ON LUN " ,I2," NO EOF.. MORE THAN " ,I3, " RECOR00500104
1DS") 00510104
77705 FORMAT ( 1X,80A1) 00520104
77706 FORMAT (10X,"FILE I06 CREATED WITH 28 SEQUENTIAL RECORDS" ) 00530104
77751 FORMAT (I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,00540104
157I1,I3/I3,2I2,3I3,I4,57I1,I3 ) 00550104
77752 FORMAT (7X,I3,6X,I4,I1,56X,I3/7X,I3,67X,I3/7X,I3,67X,I3/7X,I3,67X,00560104
1I3 ) 00570104
C 00580104
C 00590104
C ********************************************************** 00600104
C 00610104
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00620104
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00630104
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00640104
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00650104
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00660104
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00670104
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00680104
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00690104
C OF EXECUTING THESE TESTS. 00700104
C 00710104
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00720104
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00730104
C 00740104
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00750104
C 00760104
C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00770104
C SOFTWARE STANDARDS VALIDATION GROUP 00780104
C BUILDING 225 RM A266 00790104
C GAITHERSBURG, MD 20899 00800104
C ********************************************************** 00810104
C 00820104
C 00830104
C 00840104
C INITIALIZATION SECTION 00850104
C 00860104
C INITIALIZE CONSTANTS 00870104
C ************** 00880104
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00890104
I01 = 5 00900104
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00910104
I02 = 6 00920104
C SYSTEM ENVIRONMENT SECTION 00930104
C 00940104
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00950104
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00960104
C (UNIT NUMBER FOR CARD READER). 00970104
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00980104
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00990104
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01000104
C 01010104
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01020104
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01030104
C (UNIT NUMBER FOR PRINTER). 01040104
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01050104
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01060104
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01070104
C 01080104
IVPASS=0 01090104
IVFAIL=0 01100104
IVDELE=0 01110104
ICZERO=0 01120104
C 01130104
C WRITE PAGE HEADERS 01140104
WRITE (I02,90000) 01150104
WRITE (I02,90001) 01160104
WRITE (I02,90002) 01170104
WRITE (I02, 90002) 01180104
WRITE (I02,90003) 01190104
WRITE (I02,90002) 01200104
WRITE (I02,90004) 01210104
WRITE (I02,90002) 01220104
WRITE (I02,90011) 01230104
WRITE (I02,90002) 01240104
WRITE (I02,90002) 01250104
WRITE (I02,90005) 01260104
WRITE (I02,90006) 01270104
WRITE (I02,90002) 01280104
C 01290104
C DEFAULT ASSIGNMENT FOR FILE 05 IS I06 = 7 01300104
I06 = 111 01310104
CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060 01320104
CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061 01330104
C 01340104
C WRITE SECTION.... 01350104
C 01360104
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS 01370104
C 80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY 01380104
C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01390104
C ROUTINE FM104 AND FOR PURPOSES OF IDENTIFICATION IS FILE 05. 01400104
C SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4) 01410104
C RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT. ALL FOUR 01420104
C OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20 01430104
C CHARACTER PREAMBLE. THE INTEGER STORED IN CHARACTER POSITIONS 01440104
C 78 - 80 WILL EQUAL THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR 01450104
C THE FOUR RECORD SET RESPECTIVELY.. THE INTEGER ARRAY ELEMENTS 01460104
C IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9. 01470104
IPROG = 104 01480104
IFILE = 05 01490104
ILUN = I06 01500104
ITOTR = 28 01510104
IRLGN = 80 01520104
IEOF = 0000 01530104
C SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF.. 01540104
IPREM(1) = IPROG 01550104
IPREM(2) = IFILE 01560104
IPREM(3) = ILUN 01570104
IPREM(5) = ITOTR 01580104
IPREM(6) = IRLGN 01590104
C SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9 01600104
DO 10 I = 1, 57 01610104
IADN11(I) = 9 01620104
10 CONTINUE 01630104
DO 872 IRNUM = 1, 7 01640104
IF ( IRNUM .EQ. 7 ) IEOF = 9999 01650104
IPREM(4) = IRNUM 01660104
IPREM(7) = IEOF 01670104
IVON02 = IRNUM 01680104
IVON03 = IRNUM + 1 01690104
IVON04 = IRNUM + 2 01700104
IVON05 = IRNUM + 3 01710104
WRITE ( I06, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101720104
11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON01730104
205 01740104
872 CONTINUE 01750104
WRITE (I02,77706) 01760104
C 01770104
C REWIND SECTION 01780104
C 01790104
REWIND I06 01800104
C 01810104
C READ SECTION.... 01820104
C 01830104
IVTNUM = 87 01840104
C 01850104
C **** TEST 87 THRU TEST 93 **** 01860104
C TEST 87 THRU 93 - THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS 01870104
C CREATED AS FILE I06 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS, 01880104
C AND THE END OF FILE INDICATOR. 01890104
C 01900104
DO 932 IRNUM = 1, 7 01910104
IVON01 = 0 01920104
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 87 - 93.01930104
READ ( I06, 77752 ) IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,01940104
1IVON09,IRN04,IVON10 01950104
C READ THE FILE I06 - NOTE, FOUR RECORDS ARE READ IN EACH SINGLE 01960104
C READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO 01970104
C CREATE THE FILE. 01980104
C 01990104
C CHECK THE DATA ITEM VALUES .... 02000104
IF ( IRN01 .EQ. IRNUM ) IVON01 = IVON01 + 1 02010104
C IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS 02020104
C RECORD NUMBERS GO FROM 1 TO 7 .... 02030104
IF ( IVON06 .EQ. 9 ) IVON01 = IVON01 + 1 02040104
C IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL 02050104
C TO THE INTEGER CONSTANT 9 .... 02060104
IF ( IVON07 .EQ. IRNUM ) IVON01 = IVON01 + 1 02070104
C IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD 02080104
C IN THE SET OF FOUR RECORDS .... 02090104
IF ( IRN02 .EQ. IRNUM ) IVON01 = IVON01 + 1 02100104
C THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..02110104
IF ( IVON08 .EQ. IRNUM + 1 ) IVON01 = IVON01 + 1 02120104
C IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.02130104
IF ( IRN03 .EQ. IRNUM ) IVON01 = IVON01 + 1 02140104
C AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS.... 02150104
IF ( IVON09 .EQ. IRNUM + 2 ) IVON01 = IVON01 + 1 02160104
C IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4. 02170104
IF ( IRN04 .EQ. IRNUM ) IVON01 = IVON01 + 1 02180104
C STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS. 02190104
IF ( IVON10 .EQ. IRNUM + 3 ) IVON01 = IVON01 + 1 02200104
C IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.02210104
IF ( IVON01 - 9 ) 20870, 10870, 20870 02220104
C WHEN IVON01 = 9 THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...02230104
10870 IVPASS = IVPASS + 1 02240104
WRITE (I02,80001) IVTNUM 02250104
GO TO 881 02260104
20870 IVFAIL = IVFAIL + 1 02270104
IVCOMP = IVON01 02280104
IVCORR = 9 02290104
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300104
881 CONTINUE 02310104
IVTNUM = IVTNUM + 1 02320104
C INCREMENT THE TEST NUMBER.... 02330104
932 CONTINUE 02340104
IF ( ICZERO ) 30870, 941, 30870 02350104
30870 IVDELE = IVDELE + 1 02360104
WRITE (I02,80003) IVTNUM 02370104
941 CONTINUE 02380104
IVTNUM = 94 02390104
C 02400104
C **** TEST 94 **** 02410104
C TEST 94 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST02420104
C SET OF 4 RECORDS ( 25,26,27,AND 28 ). 02430104
C THE VARIABLE IEND IS ACTUALLY IN THE RECORD NUMBERED 25. 02440104
C 02450104
IF (ICZERO) 30940, 940, 30940 02460104
940 CONTINUE 02470104
IVCOMP = IEND 02480104
GO TO 40940 02490104
30940 IVDELE = IVDELE + 1 02500104
WRITE (I02,80003) IVTNUM 02510104
IF (ICZERO) 40940, 951, 40940 02520104
40940 IF ( IVCOMP - 9999 ) 20940, 10940, 20940 02530104
10940 IVPASS = IVPASS + 1 02540104
WRITE (I02,80001) IVTNUM 02550104
GO TO 951 02560104
20940 IVFAIL = IVFAIL + 1 02570104
IVCORR = 9999 02580104
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02590104
951 CONTINUE 02600104
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 05 02610104
C TO THE LINE PRINTER. 02620104
CDB** 02630104
C ILUN = I06 02640104
C ITOTR = 28 02650104
C IRLGN = 80 02660104
C7777 REWIND ILUN 02670104
C DO 7778 IRNUM = 1, ITOTR 02680104
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02690104
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02700104
C IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO ) GO TO 7779 02710104
C7778 CONTINUE 02720104
C GO TO 7782 02730104
C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 02740104
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 02750104
C GO TO 7784 02760104
C7781 WRITE (I02,77703) ILUN,ITOTR 02770104
C GO TO 7784 02780104
C7782 WRITE (I02,77704) ILUN, ITOTR 02790104
C DO 7783 I = 1, 5 02800104
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02810104
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02820104
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 02830104
C7783 CONTINUE 02840104
C7784 GO TO 99999 02850104
CDE** 02860104
C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02870104
99999 CONTINUE 02880104
WRITE (I02,90002) 02890104
WRITE (I02,90006) 02900104
WRITE (I02,90002) 02910104
WRITE (I02,90002) 02920104
WRITE (I02,90007) 02930104
WRITE (I02,90002) 02940104
WRITE (I02,90008) IVFAIL 02950104
WRITE (I02,90009) IVPASS 02960104
WRITE (I02,90010) IVDELE 02970104
C 02980104
C 02990104
C TERMINATE ROUTINE EXECUTION 03000104
STOP 03010104
C 03020104
C FORMAT STATEMENTS FOR PAGE HEADERS 03030104
90000 FORMAT ("1") 03040104
90002 FORMAT (" ") 03050104
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03060104
90003 FORMAT (" ",21X,"VERSION 2.1" ) 03070104
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03080104
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03090104
90006 FORMAT (" ",5X,"----------------------------------------------" ) 03100104
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03110104
C 03120104
C FORMAT STATEMENTS FOR RUN SUMMARIES 03130104
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03140104
90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03150104
90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03160104
C 03170104
C FORMAT STATEMENTS FOR TEST RESULTS 03180104
80001 FORMAT (" ",4X,I5,7X,"PASS") 03190104
80002 FORMAT (" ",4X,I5,7X,"FAIL") 03200104
80003 FORMAT (" ",4X,I5,7X,"DELETED") 03210104
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03220104
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03230104
C 03240104
90007 FORMAT (" ",20X,"END OF PROGRAM FM104" ) 03250104
END 03260104