C COMMENT SECTION. C C FM107 C C THIS ROUTINE IS A TEST OF THE I FORMAT AND IS TAPE AND PRINTER C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL C INTEGER ARRAY FOR THE DUMP SECTION. C C THE MAJOR PURPOSE OF THIS ROUTINE IS TO TEST WHETHER THE LAST C SET OF PARENTHESES WILL BE REPEATED IN A FORMAT STATEMENT IF THE C NUMBER OF DATA ITEMS IN THE INPUT/OUTPUT LIST IS GREATER THAN THE C NUMBER OF FIELD SPECIFICATIONS WITHIN THE FORMAT STATEMENT. C IN ADDITION THE USE OF TWO AND THREE DIMENSIONED ARRAYS IS TESTED C IN THE IMPLIED-DO LISTS IN BOTH THE WRITE AND READ SECTIONS. C C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS C AND THE END OF FILE ON THE LAST RECORD. C C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING C OF THE CONTINUATION LINE. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 8, SPECIFICATION STATEMENTS C SECTION 9, DATA STATEMENT C SECTION 11.10, DO STATEMENT C SECTION 12, INPUT/OUTPUT STATEMENTS C SECTION 12.8.2, INPUT/OUTPUT LIST C SECTION 12.9.5.2, FORMATTED DATA TRANSFER C SECTION 13, FORMAT STATEMENT C SECTION 13.2.1, EDIT DESCRIPTORS C DIMENSION IADN21(31,20), IADN31(31,10,2) DIMENSION ITEST(27) DIMENSION IDUMP(136) CHARACTER*1 NINE,IDUMP DATA NINE/'9'/ C 77701 FORMAT ( 80A1 ) 77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O 1F ,I3,8H RECORDS) 77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS) 77704 FORMAT (10X,12HFILE ON LUN ,I2,20H NO EOF.. MORE THAN ,I3,8H RECOR 1DS) 77705 FORMAT ( 1X,80A1) 77706 FORMAT (10X,44HFILE I06 CREATED WITH 137 SEQUENTIAL RECORDS ) 77751 FORMAT ( I3, 2(1I2), 3(1I3), I4, 10(1I3) ) 77752 FORMAT ( I3,2(1I2), 3(1I3), I4, 3(1I3) ) 77753 FORMAT ( //////////////// I3,2I2,3I3,I4,10(I3) ) C C C ********************************************************** C C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT C OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - C C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ********************************************************** C C C C INITIALIZATION SECTION C C INITIALIZE CONSTANTS C ************** C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. I01 = 5 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. I02 = 6 C SYSTEM ENVIRONMENT SECTION C CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 C (UNIT NUMBER FOR CARD READER). CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. C CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 C (UNIT NUMBER FOR PRINTER). CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. C IVPASS=0 IVFAIL=0 IVDELE=0 ICZERO=0 C C WRITE PAGE HEADERS WRITE (I02,90000) WRITE (I02,90001) WRITE (I02,90002) WRITE (I02, 90002) WRITE (I02,90003) WRITE (I02,90002) WRITE (I02,90004) WRITE (I02,90002) WRITE (I02,90011) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90005) WRITE (I02,90006) WRITE (I02,90002) C C DEFAULT ASSIGNMENT FOR FILE 08 IS I06 = 7 I06 = 7 CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060 CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061 C C WRITE SECTION.... C C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS C 80 CHARACTERS PER RECORD, 31 RECORDS SETS, AND CONSISTS OF ONLY C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE C ROUTINE FM107 AND FOR PURPOSES OF IDENTIFICATION IS FILE 08. IPROG = 107 IFILE = 08 ILUN = I06 ITOTR = 137 IRLGN = 80 IEOF = 0000 C THESE DO-LOOPS ARE TO SET THE VALUES INTO THE TWO AND THREE C DIMENSIONED ARRAYS FOR THE I/O LISTS.... DO 1143 IRNUM = 1, 31 DO 1142 J = 1, 20 IADN21(IRNUM,J) = IRNUM + J + 99 1142 CONTINUE 1143 CONTINUE C DO 1146 IRNUM = 1, 31 DO 1145 J = 1, 10 DO 1144 K = 1, 2 IADN31(IRNUM,J,K) = IRNUM + J + K + 298 1144 CONTINUE 1145 CONTINUE 1146 CONTINUE IFLIP = 1 DO 1149 IRNUM = 1, 31 IF ( IRNUM .EQ. 31 ) IEOF = 9999 IF ( IFLIP - 1 ) 1147, 1147, 1148 1147 WRITE ( I06, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF 1,(IADN21(IRNUM,J), J = 1, 20) IFLIP = 2 GO TO 1149 1148 WRITE ( I06, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF 1,((IADN31(IRNUM,J,K), K = 1, 2), J = 1, 10) IFLIP = 1 1149 CONTINUE WRITE (I02,77706) C C REWIND SECTION C REWIND I06 C C READ SECTION.... C IVTNUM = 114 C C **** TEST 114 THRU TEST 121 **** C TEST 114 THRU 121 - THESE TESTS READ THE SEQUENTIAL FILE C PREVIOUSLY WRITTEN ON LUN I06 AND CHECK THE FIRST AND EVERY FOURTH C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND C SEVERAL VALUES IN THE INTEGER ARRAY WHICH SHOULD FOLLOW A C CALCULATED PATTERN WITH RESPECT TO THE SUBSCRIPTS AND THE RECORD C NUMBER.... C IRNUM = 1 READ(I06,77751) ITEST C READ THE FIRST RECORD.... DO 1212 I = 1, 8 IVON01 = 0 C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST IF ( ITEST(4) .EQ. IRNUM ) IVON01 = IVON01 + 1 C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... C THE FOLLOWING TESTS ARE FOR ODD NUMBERED RECORDS IF ( ITEST(8) .EQ. IADN21(IRNUM,1) ) IVON01 = IVON01 + 1 C ELEMENT (8) SHOULD EQUAL IRNUM + 100 .... IF ( ITEST(12) .EQ. IADN21(IRNUM,5) ) IVON01 = IVON01 + 1 C ELEMENT (12) SHOULD EQUAL IRNUM + 104 .... IF ( ITEST(16) .EQ. IADN21(IRNUM,9) ) IVON01 = IVON01 + 1 C ELEMENT (16) SHOULD EQUAL IRNUM + 108 .... IF ( ITEST(20) .EQ. IADN21(IRNUM,13) ) IVON01 = IVON01 + 1 C ELEMENT (20) SHOULD EQUAL IRNUM + 112 .... IF ( ITEST(27) .EQ. IADN21(IRNUM,20) ) IVON01 = IVON01 + 1 C ELEMENT (27) SHOULD EQUAL IRNUM + 119 .... C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 41200 IF ( IVON01 - 6 ) 21200, 11200, 21200 11200 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1210 21200 IVFAIL = IVFAIL + 1 IVCOMP = IVON01 IVCORR = 6 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1210 CONTINUE IVTNUM = IVTNUM + 1 C INCREMENT THE TEST NUMBER.... C IF ( I .EQ. 8 ) GO TO 1221 C THIS CODE IS TO SKIP READING PAST THE END OF FILE BY NOT READING C FOUR RECORDS PAST RECORD NUMBER 29 ON THE 8TH LOOP.... C READ ( I06,77753 ) ITEST C READ FOUR RECORDS ON LUN I06.... IRNUM = IRNUM + 4 C INCREMENT THE RECORD NUMBER COUNTER.... 1212 CONTINUE IF ( ICZERO ) 31200, 1221, 31200 31200 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM 1221 CONTINUE IVTNUM = 122 C C **** TEST 122 **** C TEST 122 - THIS CHECKS THE VALUE OF THE VARIABLE ITEST(27) C ON RECORD NUMBER 30. ELEMENT (20) SHOULD EQUAL IADN31(30,2,10) C WHICH SHOULD BE EQUAL TO 340 .... C IF (ICZERO) 31220, 1220, 31220 1220 CONTINUE READ ( I06,77752 ) ITEST IVCOMP = ITEST(27) GO TO 41220 31220 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41220, 1231, 41220 41220 IF ( IVCOMP - 340 ) 21220, 11220, 21220 11220 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1231 21220 IVFAIL = IVFAIL + 1 IVCORR = 340 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1231 CONTINUE IVTNUM = 123 C C **** TEST 123 **** C TEST 123 - THIS CHECKS THE VALUE OF VARIABLE ITEST(27) ON C RECORD NUMBER 31 WHICH SHOULD EQUAL IADN21(31,20) = 31 + 20 + 99 C ITEST(27) SHOULD EQUAL 150 .... C IF (ICZERO) 31230, 1230, 31230 1230 CONTINUE READ ( I06,77751) ITEST IVCOMP = ITEST(27) GO TO 41230 31230 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41230, 1241, 41230 41230 IF ( IVCOMP - 150 ) 21230, 11230, 21230 11230 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1241 21230 IVFAIL = IVFAIL + 1 IVCORR = 150 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1241 CONTINUE IVTNUM = 124 C C **** TEST 124 **** C TEST 124 - THIS CHECKS FOR THE PROPER 9999 EOF INDICATOR ON C RECORD NUMBER 31 .... C IF (ICZERO) 31240, 1240, 31240 1240 CONTINUE IVCOMP = ITEST(7) GO TO 41240 31240 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41240, 1251, 41240 41240 IF ( IVCOMP - 9999 ) 21240, 11240, 21240 11240 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1251 21240 IVFAIL = IVFAIL + 1 IVCORR = 9999 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1251 CONTINUE C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 08 C TO THE LINE PRINTER. CDB** C ILUN = I06 C ITOTR = 137 C IRLGN = 80 C7777 REWIND ILUN C IENDC = 0 C IRCNT = 0 C DO 7778 IRNUM = 1, ITOTR C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) C IRCNT = IRCNT + 1 C IF ( IDUMP(20) .EQ. NINE ) IENDC = IRNUM C7778 CONTINUE C IF ( IENDC - 136 ) 7780, 7779, 7782 C7779 IF ( IRCNT - ITOTR ) 7780, 7781, 7782 C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR C GO TO 7784 C7781 WRITE (I02,77703) ILUN,ITOTR C GO TO 7784 C7782 WRITE (I02,77704) ILUN, ITOTR C DO 7783 I = 1, 5 C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 C7783 CONTINUE C7784 GO TO 99999 CDE** C WRITE PAGE FOOTINGS AND RUN SUMMARIES 99999 CONTINUE WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90007) WRITE (I02,90002) WRITE (I02,90008) IVFAIL WRITE (I02,90009) IVPASS WRITE (I02,90010) IVDELE C C C TERMINATE ROUTINE EXECUTION STOP C C FORMAT STATEMENTS FOR PAGE HEADERS 90000 FORMAT (1H1) 90002 FORMAT (1H ) 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90003 FORMAT (1H ,21X,11HVERSION 1.0) 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 90006 FORMAT (1H ,5X,46H----------------------------------------------) 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARIES 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) C C FORMAT STATEMENTS FOR TEST RESULTS 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) C 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM107) END