PROGRAM FM100 C COMMENT SECTION. 00010100 C 00020100 C FM100 00030100 C 00040100 C THIS ROUTINE IS A TEST OF THE I FORMAT AND IS TAPE AND PRINTER00050100 C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060100 C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070100 C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080100 C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090100 C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100100 C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110100 C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120100 C INTEGER ARRAY FOR THE DUMP SECTION. 00130100 C 00140100 C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150100 C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS 00160100 C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS 00170100 C AND THE END OF FILE ON THE LAST RECORD. 00180100 C 00190100 C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00200100 C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00210100 C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00220100 C OF THE CONTINUATION LINE. 00230100 C 00240100 C REFERENCES 00250100 C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260100 C X3.9-1978 00270100 C 00280100 C SECTION 8, SPECIFICATION STATEMENTS 00290100 C SECTION 9, DATA STATEMENT 00300100 C SECTION 11.10, DO STATEMENT 00310100 C SECTION 12, INPUT/OUTPUT STATEMENTS 00320100 C SECTION 12.8.2, INPUT/OUTPUT LIST 00330100 C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00340100 C SECTION 13, FORMAT STATEMENT 00350100 C SECTION 13.2.1, EDIT DESCRIPTORS 00360100 C SECTION 13.5.9.1, INTEGER EDITING 00370100 C 00380100 DIMENSION ITEST(30) 00390100 DIMENSION IDUMP(136) 00400100 CHARACTER*1 NINE,IDUMP 00410100 DATA NINE/'9'/ 00420100 C 00430100 77701 FORMAT ( 80A1 ) 00440100 77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00450100 1F ",I3," RECORDS") 00460100 77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00470100 77704 FORMAT (10X,"FILE ON LUN " ,I2," TOO LONG MORE THAN " ,I3, " RECOR00480100 1DS") 00490100 77705 FORMAT ( 1X,80A1) 00500100 77706 FORMAT (10X,"FILE I06 CREATED WITH 31 SEQUENTIAL RECORDS" ) 00510100 77751 FORMAT (I3,I2,I2,I3,I3,I3,I4,I1,I1,I1,I1,I1,I1,I1,I1,I1,I1,I2,I2,I00520100 13,I3,I4,I4,I4,I4,I4,I5,I5,I5,I5) 00530100 C 00540100 C 00550100 C ********************************************************** 00560100 C 00570100 C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00580100 C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00590100 C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00600100 C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00610100 C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00620100 C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00630100 C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00640100 C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00650100 C OF EXECUTING THESE TESTS. 00660100 C 00670100 C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00680100 C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00690100 C 00700100 C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00710100 C 00720100 C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00730100 C SOFTWARE STANDARDS VALIDATION GROUP 00740100 C BUILDING 225 RM A266 00750100 C GAITHERSBURG, MD 20899 00760100 C ********************************************************** 00770100 C 00780100 C 00790100 C 00800100 C INITIALIZATION SECTION 00810100 C 00820100 C INITIALIZE CONSTANTS 00830100 C ************** 00840100 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00850100 I01 = 5 00860100 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00870100 I02 = 6 00880100 C SYSTEM ENVIRONMENT SECTION 00890100 C 00900100 CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00910100 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00920100 C (UNIT NUMBER FOR CARD READER). 00930100 CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00940100 C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00950100 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00960100 C 00970100 CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00980100 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00990100 C (UNIT NUMBER FOR PRINTER). 01000100 CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01010100 C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01020100 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01030100 C 01040100 IVPASS=0 01050100 IVFAIL=0 01060100 IVDELE=0 01070100 ICZERO=0 01080100 C 01090100 C WRITE PAGE HEADERS 01100100 WRITE (I02,90000) 01110100 WRITE (I02,90001) 01120100 WRITE (I02,90002) 01130100 WRITE (I02, 90002) 01140100 WRITE (I02,90003) 01150100 WRITE (I02,90002) 01160100 WRITE (I02,90004) 01170100 WRITE (I02,90002) 01180100 WRITE (I02,90011) 01190100 WRITE (I02,90002) 01200100 WRITE (I02,90002) 01210100 WRITE (I02,90005) 01220100 WRITE (I02,90006) 01230100 WRITE (I02,90002) 01240100 C 01250100 C DEFAULT ASSIGNMENT FOR FILE 01 IS I06 = 7 01260100 I06 = 7 01270100 CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060 01280100 CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061 01290100 C 01300100 C WRITE SECTION.... 01310100 C 01320100 C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS 01330100 C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY 01340100 C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01350100 C ROUTINE FM100 AND FOR PURPOSES OF IDENTIFICATION IS FILE 01. 01360100 C ALL OF THE DATA WITH THE EXCEPTION OF THE RECORD NUMBER - IRNUM , 01370100 C INTEGER VARIABLE ICON31 WHICH IS SET TO THE VALUE OF THE RECORD 01380100 C NUMBER, AND THE END OF FILE CHECK - IEOF IS SET BY INTEGER 01390100 C ASSIGNMENT STATEMENTS TO VARIOUS INTEGER CONSTANTS. 01400100 IPROG = 100 01410100 IFILE = 01 01420100 ILUN = I06 01430100 ITOTR = 31 01440100 IRLGN = 80 01450100 IEOF = 0000 01460100 ICON11 = 1 01470100 ICON12 = 2 01480100 ICON13 = 3 01490100 ICON14 = 4 01500100 ICON15 = 5 01510100 ICON16 = 6 01520100 ICON17 = 7 01530100 ICON18 = 8 01540100 ICON19 = 9 01550100 ICON10 = 0 01560100 ICON21 = 21 01570100 ICON22 = 22 01580100 ICON32 = 512 01590100 ICON41 = 9995 01600100 ICON42 = 9996 01610100 ICON43 = 9997 01620100 ICON44 = 9998 01630100 ICON45 = 9999 01640100 ICON51 = 32764 01650100 ICON52 = 32765 01660100 ICON53 = 32766 01670100 ICON54 = 32767 01680100 DO 12 IRNUM = 1, 31 01690100 ICON31 = IRNUM 01700100 IF ( IRNUM .EQ. 31 ) IEOF = 9999 01710100 WRITE(I06,77751)IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,ICON11,ICO01720100 1N12,ICON13,ICON14,ICON15,ICON16,ICON17,ICON18,ICON19,ICON10,ICON2101730100 2,ICON22,ICON31,ICON32,ICON41,ICON42,ICON43,ICON44,ICON45,ICON51,IC01740100 3ON52,ICON53,ICON54 01750100 12 CONTINUE 01760100 WRITE (I02,77706) 01770100 C 01780100 C REWIND SECTION 01790100 C 01800100 REWIND I06 01810100 C 01820100 C READ SECTION.... 01830100 C 01840100 IVTNUM = 1 01850100 C 01860100 C **** TEST 1 THRU TEST 8 **** 01870100 C TEST 1 THRU TEST 8 - THESE TESTS READ THE SEQUENTIAL FILE 01880100 C PREVIOUSLY WRITTEN ON LUN I06 AND CHECK THE FIRST AND EVERY FOURTH01890100 C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND 01900100 C SEVERAL VALUES WHICH SHOULD REMAIN CONSTANT FOR ALL OF THE 31 01910100 C RECORDS. 01920100 C 01930100 IRTST = 1 01940100 READ(I06,77751) ITEST 01950100 C READ THE FIRST RECORD.... 01960100 DO 23 I = 1, 8 01970100 IVON01 = 0 01980100 C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 1 THRU 801990100 IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 02000100 C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... 02010100 IF ( ITEST(8) .EQ. ICON11 ) IVON01 = IVON01 + 1 02020100 C THE ELEMENT (8) SHOULD EQUAL ICON11 = 1.... 02030100 IF ( ITEST(18) .EQ. ICON21 ) IVON01 = IVON01 + 1 02040100 C THE ELEMENT (18) SHOULD EQUAL ICON21 = 21.... 02050100 IF ( ITEST(20) .EQ. IRTST ) IVON01 = IVON01 + 1 02060100 C THE ELEMENT (20) SHOULD ALSO EQUAL THE RECORD NUMBER.... 02070100 IF ( ITEST(26) .EQ. ICON45 ) IVON01 = IVON01 + 1 02080100 C THE ELEMENT (26. SHOULD EQUAL ICON45 = 9999.... 02090100 IF ( ITEST(30) .EQ. ICON54 ) IVON01 = IVON01 + 1 02100100 C THE ELEMENT (30) SHOULD EQUAL ICON54 = 32767.... 02110100 IF ( IVON01 - 6 ) 20010, 10010, 20010 02120100 C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02130100 C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02140100 C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02150100 10010 IVPASS = IVPASS + 1 02160100 WRITE (I02,80001) IVTNUM 02170100 GO TO 21 02180100 20010 IVFAIL = IVFAIL + 1 02190100 IVCOMP = IVON01 02200100 IVCORR = 6 02210100 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02220100 21 CONTINUE 02230100 IVTNUM = IVTNUM + 1 02240100 C INCREMENT THE TEST NUMBER.... 02250100 IF ( IVTNUM .EQ. 9 ) GO TO 91 02260100 C TAPE SHOULD BE AT RECORD NUMBER 29 FOR TEST 8 - DO NOT READ MORE02270100 C UNTIL TEST NUMBER NINE WHICH CHECKS RECORD NUMBER 30.... 02280100 DO 22 J = 1, 4 02290100 READ(I06,77751) ITEST 02300100 C READ FOUR RECORDS ON LUN I06.... 02310100 22 CONTINUE 02320100 IRTST = IRTST + 4 02330100 C INCREMENT THE RECORD NUMBER COUNTER.... 02340100 23 CONTINUE 02350100 IF (ICZERO) 30010, 91, 30010 02360100 30010 IVDELE = IVDELE + 1 02370100 WRITE (I02,80003) IVTNUM 02380100 91 CONTINUE 02390100 IVTNUM = 9 02400100 C 02410100 C **** TEST 9 **** 02420100 C TEST 9 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 30. 02430100 C 02440100 IF (ICZERO) 30090, 90, 30090 02450100 90 CONTINUE 02460100 READ ( I06, 77751 ) ITEST 02470100 IVCOMP = ITEST(4) 02480100 GO TO 40090 02490100 30090 IVDELE = IVDELE + 1 02500100 WRITE (I02,80003) IVTNUM 02510100 IF (ICZERO) 40090, 101, 40090 02520100 40090 IF ( IVCOMP - 30 ) 20090, 10090, 20090 02530100 10090 IVPASS = IVPASS + 1 02540100 WRITE (I02,80001) IVTNUM 02550100 GO TO 101 02560100 20090 IVFAIL = IVFAIL + 1 02570100 IVCORR = 30 02580100 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02590100 101 CONTINUE 02600100 IVTNUM = 10 02610100 C 02620100 C **** TEST 10 **** 02630100 C TEST 10 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 31. 02640100 C 02650100 IF (ICZERO) 30100, 100, 30100 02660100 100 CONTINUE 02670100 READ ( I06,77751) ITEST 02680100 IVCOMP = ITEST(4) 02690100 GO TO 40100 02700100 30100 IVDELE = IVDELE + 1 02710100 WRITE (I02,80003) IVTNUM 02720100 IF (ICZERO) 40100, 111, 40100 02730100 40100 IF ( IVCOMP - 31 ) 20100, 10100, 20100 02740100 10100 IVPASS = IVPASS + 1 02750100 WRITE (I02,80001) IVTNUM 02760100 GO TO 111 02770100 20100 IVFAIL = IVFAIL + 1 02780100 IVCORR = 31 02790100 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02800100 111 CONTINUE 02810100 IVTNUM = 11 02820100 C 02830100 C **** TEST 11 **** 02840100 C TEST 11 - THIS CHECKS FOR THE CORRECT END OF FILE CODE 9999 02850100 C ON RECORD NUMBER 31. 02860100 C 02870100 IF (ICZERO) 30110, 110, 30110 02880100 110 CONTINUE 02890100 IVCOMP = ITEST(7) 02900100 GO TO 40110 02910100 30110 IVDELE = IVDELE + 1 02920100 WRITE (I02,80003) IVTNUM 02930100 IF (ICZERO) 40110, 121, 40110 02940100 40110 IF ( IVCOMP - 9999 ) 20110, 10110, 20110 02950100 10110 IVPASS = IVPASS + 1 02960100 WRITE (I02,80001) IVTNUM 02970100 GO TO 121 02980100 20110 IVFAIL = IVFAIL + 1 02990100 IVCORR = 9999 03000100 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03010100 121 CONTINUE 03020100 C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 01 03030100 C TO THE LINE PRINTER. 03040100 CDB** 03050100 C ILUN = I06 03060100 C ITOTR = 31 03070100 C IRLGN = 80 03080100 C7777 REWIND ILUN 03090100 C DO 7778 IRNUM = 1, ITOTR 03100100 C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03110100 C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03120100 C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 03130100 C7778 CONTINUE 03140100 C GO TO 7782 03150100 C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 03160100 C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03170100 C GO TO 7784 03180100 C7781 WRITE (I02,77703) ILUN,ITOTR 03190100 C GO TO 7784 03200100 C7782 WRITE (I02,77704) ILUN, ITOTR 03210100 C DO 7783 I = 1, 5 03220100 C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03230100 C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03240100 C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03250100 C7783 CONTINUE 03260100 C7784 GO TO 99999 03270100 CDE** 03280100 C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03290100 99999 CONTINUE 03300100 WRITE (I02,90002) 03310100 WRITE (I02,90006) 03320100 WRITE (I02,90002) 03330100 WRITE (I02,90002) 03340100 WRITE (I02,90007) 03350100 WRITE (I02,90002) 03360100 WRITE (I02,90008) IVFAIL 03370100 WRITE (I02,90009) IVPASS 03380100 WRITE (I02,90010) IVDELE 03390100 C 03400100 C 03410100 C TERMINATE ROUTINE EXECUTION 03420100 STOP 03430100 C 03440100 C FORMAT STATEMENTS FOR PAGE HEADERS 03450100 90000 FORMAT ("1") 03460100 90002 FORMAT (" ") 03470100 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03480100 90003 FORMAT (" ",21X,"VERSION 2.1" ) 03490100 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03500100 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03510100 90006 FORMAT (" ",5X,"----------------------------------------------" ) 03520100 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03530100 C 03540100 C FORMAT STATEMENTS FOR RUN SUMMARIES 03550100 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03560100 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03570100 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03580100 C 03590100 C FORMAT STATEMENTS FOR TEST RESULTS 03600100 80001 FORMAT (" ",4X,I5,7X,"PASS") 03610100 80002 FORMAT (" ",4X,I5,7X,"FAIL") 03620100 80003 FORMAT (" ",4X,I5,7X,"DELETED") 03630100 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03640100 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03650100 C 03660100 90007 FORMAT (" ",20X,"END OF PROGRAM FM100" ) 03670100 END 03680100