|
|
1.1 ! root 1: C COMMENT SECTION 00010001 ! 2: C DATE***82/08/02*18.33.46 ! 3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 4: C AUDIT FCVS78 V2.0 ! 5: C 00020001 ! 6: C FM001 00030001 ! 7: C 00040001 ! 8: C THIS ROUTINE CONTAINS THE BOILERPLATE SOURCE CODING WHICH 00050001 ! 9: C IS USED TO PRINT THE REPORT HEADINGS AND RUN SUMMARIES FOR EACH 00060001 ! 10: C OF THE ELEMENTARY ROUTINES. 00070001 ! 11: C 00080001 ! 12: C THREE TESTS ARE INCLUDED WHICH CONTAIN THE PROCEDURES FOR 00090001 ! 13: C TESTING THE LANGUAGE FEATURES AND DELETING TESTS. 00100001 ! 14: C 00110001 ! 15: C TEST 1 CHECKS THE PASS PROCEDURE 00120001 ! 16: C TEST 2 CHECKS THE FAIL PROCEDURE 00130001 ! 17: C TEST 3 CHECKS THE DELETE PROCEDURE 00140001 ! 18: C 00150001 ! 19: C IF THIS ROUTINE DOES NOT EXECUTE CORRECTLY, THEN NO OTHER 00160001 ! 20: C ROUTINES WILL BE RUN. THERE IS NO USE IN TRYING TO VALIDATE A 00170001 ! 21: C FORTRAN COMPILER WHICH CANNOT HANDLE SUCH BASIC STATEMENTS. 00180001 ! 22: C 00190001 ! 23: C ********************************************************** 00200001 ! 24: C 00210001 ! 25: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00220001 ! 26: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00230001 ! 27: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00240001 ! 28: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00250001 ! 29: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00260001 ! 30: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00270001 ! 31: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00280001 ! 32: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00290001 ! 33: C OF EXECUTING THESE TESTS. 00300001 ! 34: C 00310001 ! 35: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00320001 ! 36: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00330001 ! 37: C 00340001 ! 38: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00350001 ! 39: C 00360001 ! 40: C DEPARTMENT OF THE NAVY 00370001 ! 41: C FEDERAL COBOL COMPILER TESTING SERVICE 00380001 ! 42: C WASHINGTON, D.C. 20376 00390001 ! 43: C 00400001 ! 44: C ********************************************************** 00410001 ! 45: C 00420001 ! 46: C 00430001 ! 47: C 00440001 ! 48: C INITIALIZATION SECTION 00450001 ! 49: C 00460001 ! 50: C INITIALIZE CONSTANTS 00470001 ! 51: C ************** 00480001 ! 52: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00490001 ! 53: I01 = 5 00500001 ! 54: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00510001 ! 55: I02 = 6 00520001 ! 56: C SYSTEM ENVIRONMENT SECTION 00530001 ! 57: C 00540001 ! 58: I01 = 5 00550001 ! 59: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00560001 ! 60: C (UNIT NUMBER FOR CARD READER). 00570001 ! 61: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00580001 ! 62: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00590001 ! 63: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00600001 ! 64: C 00610001 ! 65: I02 = 6 00620001 ! 66: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00630001 ! 67: C (UNIT NUMBER FOR PRINTER). 00640001 ! 68: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00650001 ! 69: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660001 ! 70: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00670001 ! 71: C 00680001 ! 72: IVPASS=0 00690001 ! 73: IVFAIL=0 00700001 ! 74: IVDELE=0 00710001 ! 75: ICZERO=0 00720001 ! 76: C 00730001 ! 77: C WRITE PAGE HEADERS 00740001 ! 78: WRITE (I02,90000) 00750001 ! 79: WRITE (I02,90001) 00760001 ! 80: WRITE (I02,90002) 00770001 ! 81: WRITE (I02, 90002) 00780001 ! 82: WRITE (I02,90003) 00790001 ! 83: WRITE (I02,90002) 00800001 ! 84: WRITE (I02,90004) 00810001 ! 85: WRITE (I02,90002) 00820001 ! 86: WRITE (I02,90011) 00830001 ! 87: WRITE (I02,90002) 00840001 ! 88: WRITE (I02,90002) 00850001 ! 89: WRITE (I02,90005) 00860001 ! 90: WRITE (I02,90006) 00870001 ! 91: WRITE (I02,90002) 00880001 ! 92: C TEST SECTION 00890001 ! 93: C 00900001 ! 94: 11 CONTINUE 00910001 ! 95: C 00920001 ! 96: C **** TEST 001 **** 00930001 ! 97: C TEST 001 - BASIC PROCEDURE FOR CODING TESTS 00940001 ! 98: C ALSO CHECKS CONTINUE STATEMENT WHICH SHOULD NOT HAVE 00950001 ! 99: C ANY AFFECT ON EXECUTION SEQUENCE 00960001 ! 100: C 00970001 ! 101: IF (ICZERO) 30010, 10, 30010 00980001 ! 102: 10 CONTINUE 00990001 ! 103: IVTNUM=1 01000001 ! 104: GO TO 40010 01010001 ! 105: 30010 IVDELE=IVDELE+1 01020001 ! 106: WRITE (I02,80003) IVTNUM 01030001 ! 107: IF (ICZERO) 40010, 21, 40010 01040001 ! 108: 40010 IF (IVTNUM - 1) 20010, 10010, 20010 01050001 ! 109: 10010 IVPASS=IVPASS+1 01060001 ! 110: WRITE (I02,80001) IVTNUM 01070001 ! 111: GO TO 21 01080001 ! 112: 20010 IVFAIL=IVFAIL+1 01090001 ! 113: IVCOMP=IVTNUM 01100001 ! 114: IVCORR=1 01110001 ! 115: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01120001 ! 116: 21 CONTINUE 01130001 ! 117: C 01140001 ! 118: C **** TEST 002 **** 01150001 ! 119: C TEST - 002 FORCE FAIL CODE TO BE EXECUTED 01160001 ! 120: C 01170001 ! 121: IF (ICZERO) 30020,20,30020 01180001 ! 122: 20 CONTINUE 01190001 ! 123: IVTNUM=2 01200001 ! 124: GO TO 40020 01210001 ! 125: 30020 IVDELE=IVDELE+1 01220001 ! 126: WRITE (I02,80003) IVTNUM 01230001 ! 127: IF (ICZERO) 40020,31,40020 01240001 ! 128: 40020 IF (IVTNUM-1) 20020, 10020, 20020 01250001 ! 129: 10020 IVPASS=IVPASS+1 01260001 ! 130: WRITE (I02,80001) IVTNUM 01270001 ! 131: GO TO 31 01280001 ! 132: 20020 IVFAIL=IVFAIL+1 01290001 ! 133: IVCOMP=IVTNUM 01300001 ! 134: IVCORR=2 01310001 ! 135: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01320001 ! 136: 31 CONTINUE 01330001 ! 137: C 01340001 ! 138: C **** TEST 003 **** 01350001 ! 139: C TEST 003 - DELETE PROCEDURE TESTED 01360001 ! 140: C 01370001 ! 141: IF (ICZERO) 30030,30,30030 01380001 ! 142: 30 CONTINUE 01390001 ! 143: C IVTNUM=5000 01400001 ! 144: C GO TO 40030 01410001 ! 145: 30030 IVDELE=IVDELE+1 01420001 ! 146: IVTNUM=3 01430001 ! 147: WRITE (I02,80003) IVTNUM 01440001 ! 148: IF (ICZERO) 40030,99999,40030 01450001 ! 149: 40030 IF (IVTNUM - 5000) 20030,10030,20030 01460001 ! 150: 10030 IVPASS=IVPASS +1 01470001 ! 151: WRITE (I02,80001) IVTNUM 01480001 ! 152: GO TO 99999 01490001 ! 153: 20030 IVFAIL=IVFAIL+1 01500001 ! 154: IVCOMP=IVTNUM 01510001 ! 155: IVCORR=5000 01520001 ! 156: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01530001 ! 157: C 01540001 ! 158: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 01550001 ! 159: 99999 CONTINUE 01560001 ! 160: WRITE (I02,90002) 01570001 ! 161: WRITE (I02,90006) 01580001 ! 162: WRITE (I02,90002) 01590001 ! 163: WRITE (I02,90002) 01600001 ! 164: WRITE (I02,90007) 01610001 ! 165: WRITE (I02,90002) 01620001 ! 166: WRITE (I02,90008) IVFAIL 01630001 ! 167: WRITE (I02,90009) IVPASS 01640001 ! 168: WRITE (I02,90010) IVDELE 01650001 ! 169: C 01660001 ! 170: C 01670001 ! 171: C SPECIAL OUTPUT STATEMENTS FOR THIS ROUTINE 01680001 ! 172: WRITE (I02,90000) 01690001 ! 173: WRITE (I02,90002) 01700001 ! 174: WRITE (I02,80031) 01710001 ! 175: WRITE (I02,90002) 01720001 ! 176: WRITE (I02,80010) 01730001 ! 177: WRITE (I02,80020) 01740001 ! 178: WRITE (I02,80030) 01750001 ! 179: WRITE (I02,80032) 01760001 ! 180: C 01770001 ! 181: C TERMINATE ROUTINE EXECUTION 01780001 ! 182: STOP 01790001 ! 183: C 01800001 ! 184: C FORMAT STATEMENTS FOR PAGE HEADERS 01810001 ! 185: 90000 FORMAT (1H1) 01820001 ! 186: 90002 FORMAT (1H ) 01830001 ! 187: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 01840001 ! 188: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 01850001 ! 189: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 01860001 ! 190: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 01870001 ! 191: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 01880001 ! 192: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 01890001 ! 193: C 01900001 ! 194: C FORMAT STATEMENTS FOR RUN SUMMARIES 01910001 ! 195: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 01920001 ! 196: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 01930001 ! 197: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 01940001 ! 198: C 01950001 ! 199: C FORMAT STATEMENTS FOR TEST RESULTS 01960001 ! 200: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 01970001 ! 201: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 01980001 ! 202: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 01990001 ! 203: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02000001 ! 204: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02010001 ! 205: C 02020001 ! 206: C FORMATS FOR CURRENT ROUTINE 02030001 ! 207: 80031 FORMAT (1H ,10X,39HTHE PROGRAM FM001 EXECUTED CORRECTLY IF) 02040001 ! 208: 80010 FORMAT (1H ,15X,13HTEST 1 PASSED) 02050001 ! 209: 80020 FORMAT (1H ,15X,42HTEST 2 FAILED WITH COMPUTED AND CORRECT =2) 02060001 ! 210: 80030 FORMAT (1H ,15X,18HTEST 3 WAS DELETED) 02070001 ! 211: 80032 FORMAT (1H ,15X,34HTHE RUN SUMMARY TOTALS ALL EQUAL 1) 02080001 ! 212: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM001) 02090001 ! 213: END 02100001
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.