![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM014.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM014.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C 00010014 ! 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 COMMENT SECTION. 00020014 ! 6: C 00030014 ! 7: C FM014 00040014 ! 8: C 00050014 ! 9: C THIS ROUTINE TESTS THE FORTRAN COMPUTED GO TO STATEMENT.00060014 ! 10: C BECAUSE THE FORM OF THE COMPUTED GO TO IS SO STRAIGHTFORWARD, THE 00070014 ! 11: C TESTS MAINLY RELATE TO THE RANGE OF POSSIBLE STATEMENT NUMBERS 00080014 ! 12: C WHICH ARE USED. 00090014 ! 13: C 00100014 ! 14: C REFERENCES 00110014 ! 15: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00120014 ! 16: C X3.9-1978 00130014 ! 17: C 00140014 ! 18: C SECTION 11.2, COMPUTED GO TO STATEMENT 00150014 ! 19: C 00160014 ! 20: C 00170014 ! 21: C ********************************************************** 00180014 ! 22: C 00190014 ! 23: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200014 ! 24: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00210014 ! 25: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00220014 ! 26: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00230014 ! 27: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00240014 ! 28: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00250014 ! 29: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00260014 ! 30: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00270014 ! 31: C OF EXECUTING THESE TESTS. 00280014 ! 32: C 00290014 ! 33: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00300014 ! 34: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00310014 ! 35: C 00320014 ! 36: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00330014 ! 37: C 00340014 ! 38: C DEPARTMENT OF THE NAVY 00350014 ! 39: C FEDERAL COBOL COMPILER TESTING SERVICE 00360014 ! 40: C WASHINGTON, D.C. 20376 00370014 ! 41: C 00380014 ! 42: C ********************************************************** 00390014 ! 43: C 00400014 ! 44: C 00410014 ! 45: C 00420014 ! 46: C INITIALIZATION SECTION 00430014 ! 47: C 00440014 ! 48: C INITIALIZE CONSTANTS 00450014 ! 49: C ************** 00460014 ! 50: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00470014 ! 51: I01 = 5 00480014 ! 52: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00490014 ! 53: I02 = 6 00500014 ! 54: C SYSTEM ENVIRONMENT SECTION 00510014 ! 55: C 00520014 ! 56: I01 = 5 00530014 ! 57: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00540014 ! 58: C (UNIT NUMBER FOR CARD READER). 00550014 ! 59: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00560014 ! 60: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00570014 ! 61: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00580014 ! 62: C 00590014 ! 63: I02 = 6 00600014 ! 64: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00610014 ! 65: C (UNIT NUMBER FOR PRINTER). 00620014 ! 66: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00630014 ! 67: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00640014 ! 68: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00650014 ! 69: C 00660014 ! 70: IVPASS=0 00670014 ! 71: IVFAIL=0 00680014 ! 72: IVDELE=0 00690014 ! 73: ICZERO=0 00700014 ! 74: C 00710014 ! 75: C WRITE PAGE HEADERS 00720014 ! 76: WRITE (I02,90000) 00730014 ! 77: WRITE (I02,90001) 00740014 ! 78: WRITE (I02,90002) 00750014 ! 79: WRITE (I02, 90002) 00760014 ! 80: WRITE (I02,90003) 00770014 ! 81: WRITE (I02,90002) 00780014 ! 82: WRITE (I02,90004) 00790014 ! 83: WRITE (I02,90002) 00800014 ! 84: WRITE (I02,90011) 00810014 ! 85: WRITE (I02,90002) 00820014 ! 86: WRITE (I02,90002) 00830014 ! 87: WRITE (I02,90005) 00840014 ! 88: WRITE (I02,90006) 00850014 ! 89: WRITE (I02,90002) 00860014 ! 90: IVTNUM = 131 00870014 ! 91: C 00880014 ! 92: C TEST 131 - TEST OF THE SIMPLIST FORM OF THE COMPUTED GO TO 00890014 ! 93: C STATEMENT WITH THREE POSSIBLE BRANCHES. 00900014 ! 94: C 00910014 ! 95: C 00920014 ! 96: IF (ICZERO) 31310, 1310, 31310 00930014 ! 97: 1310 CONTINUE 00940014 ! 98: ICON01=0 00950014 ! 99: I=3 00960014 ! 100: GO TO ( 1312, 1313, 1314 ), I 00970014 ! 101: 1312 ICON01 = 1312 00980014 ! 102: GO TO 1315 00990014 ! 103: 1313 ICON01 = 1313 01000014 ! 104: GO TO 1315 01010014 ! 105: 1314 ICON01 = 1314 01020014 ! 106: 1315 CONTINUE 01030014 ! 107: GO TO 41310 01040014 ! 108: 31310 IVDELE = IVDELE + 1 01050014 ! 109: WRITE (I02,80003) IVTNUM 01060014 ! 110: IF (ICZERO) 41310, 1321, 41310 01070014 ! 111: 41310 IF ( ICON01 - 1314 ) 21310, 11310, 21310 01080014 ! 112: 11310 IVPASS = IVPASS + 1 01090014 ! 113: WRITE (I02,80001) IVTNUM 01100014 ! 114: GO TO 1321 01110014 ! 115: 21310 IVFAIL = IVFAIL + 1 01120014 ! 116: IVCOMP=ICON01 01130014 ! 117: IVCORR = 1314 01140014 ! 118: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01150014 ! 119: 1321 CONTINUE 01160014 ! 120: IVTNUM = 132 01170014 ! 121: C 01180014 ! 122: C TEST 132 - THIS TESTS THE COMPUTED GO TO IN CONJUNCTION WITH THE01190014 ! 123: C THE UNCONDITIONAL GO TO STATEMENT. THIS TEST IS NOT 01200014 ! 124: C INTENDED TO BE AN EXAMPLE OF GOOD STRUCTURED PROGRAMMING. 01210014 ! 125: C 01220014 ! 126: C 01230014 ! 127: IF (ICZERO) 31320, 1320, 31320 01240014 ! 128: 1320 CONTINUE 01250014 ! 129: IVON01=0 01260014 ! 130: J=1 01270014 ! 131: GO TO 1326 01280014 ! 132: 1322 J = 2 01290014 ! 133: IVON01=IVON01+2 01300014 ! 134: GO TO 1326 01310014 ! 135: 1323 J = 3 01320014 ! 136: IVON01=IVON01 * 10 + 3 01330014 ! 137: GO TO 1326 01340014 ! 138: 1324 J = 4 01350014 ! 139: IVON01=IVON01 * 100 + 4 01360014 ! 140: GO TO 1326 01370014 ! 141: 1325 IVON01 = IVON01 + 1 01380014 ! 142: GO TO 1327 01390014 ! 143: 1326 GO TO ( 1322, 1323, 1324, 1325, 1326 ), J 01400014 ! 144: 1327 CONTINUE 01410014 ! 145: GO TO 41320 01420014 ! 146: 31320 IVDELE = IVDELE + 1 01430014 ! 147: WRITE (I02,80003) IVTNUM 01440014 ! 148: IF (ICZERO) 41320, 1331, 41320 01450014 ! 149: 41320 IF ( IVON01 - 2305 ) 21320, 11320, 21320 01460014 ! 150: 11320 IVPASS = IVPASS + 1 01470014 ! 151: WRITE (I02,80001) IVTNUM 01480014 ! 152: GO TO 1331 01490014 ! 153: 21320 IVFAIL = IVFAIL + 1 01500014 ! 154: IVCOMP=IVON01 01510014 ! 155: IVCORR=2305 01520014 ! 156: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01530014 ! 157: 1331 CONTINUE 01540014 ! 158: IVTNUM = 133 01550014 ! 159: C 01560014 ! 160: C TEST 133 - THIS IS A TEST OF THE COMPUTED GO TO STATEMENT WITH 01570014 ! 161: C A SINGLE STATEMENT LABEL AS THE LIST OF POSSIBLE BRANCHES. 01580014 ! 162: C 01590014 ! 163: C 01600014 ! 164: IF (ICZERO) 31330, 1330, 31330 01610014 ! 165: 1330 CONTINUE 01620014 ! 166: IVON01=0 01630014 ! 167: K=1 01640014 ! 168: GO TO ( 1332 ), K 01650014 ! 169: 1332 IVON01 = 1 01660014 ! 170: GO TO 41330 01670014 ! 171: 31330 IVDELE = IVDELE + 1 01680014 ! 172: WRITE (I02,80003) IVTNUM 01690014 ! 173: IF (ICZERO) 41330, 1341, 41330 01700014 ! 174: 41330 IF ( IVON01 - 1 ) 21330, 11330, 21330 01710014 ! 175: 11330 IVPASS = IVPASS + 1 01720014 ! 176: WRITE (I02,80001) IVTNUM 01730014 ! 177: GO TO 1341 01740014 ! 178: 21330 IVFAIL = IVFAIL + 1 01750014 ! 179: IVCOMP=IVON01 01760014 ! 180: IVCORR=1 01770014 ! 181: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780014 ! 182: 1341 CONTINUE 01790014 ! 183: IVTNUM = 134 01800014 ! 184: C 01810014 ! 185: C TEST 134 - THIS IS A TEST OF FIVE (5) DIGIT STATEMENT NUMBERS 01820014 ! 186: C WHICH EXCEED THE INTEGER 32767 USED IN THE COMPUTED GO TO 01830014 ! 187: C STATEMENT WITH THREE POSSIBLE BRANCHES. 01840014 ! 188: C 01850014 ! 189: C 01860014 ! 190: IF (ICZERO) 31340, 1340, 31340 01870014 ! 191: 1340 CONTINUE 01880014 ! 192: IVON01=0 01890014 ! 193: L=2 01900014 ! 194: GO TO ( 99991, 99992, 99993 ), L 01910014 ! 195: 99991 IVON01=1 01920014 ! 196: GO TO 1342 01930014 ! 197: 99992 IVON01=2 01940014 ! 198: GO TO 1342 01950014 ! 199: 99993 IVON01=3 01960014 ! 200: 1342 CONTINUE 01970014 ! 201: GO TO 41340 01980014 ! 202: 31340 IVDELE = IVDELE + 1 01990014 ! 203: WRITE (I02,80003) IVTNUM 02000014 ! 204: IF (ICZERO) 41340, 1351, 41340 02010014 ! 205: 41340 IF ( IVON01 - 2 ) 21340, 11340, 21340 02020014 ! 206: 11340 IVPASS = IVPASS + 1 02030014 ! 207: WRITE (I02,80001) IVTNUM 02040014 ! 208: GO TO 1351 02050014 ! 209: 21340 IVFAIL = IVFAIL + 1 02060014 ! 210: IVCOMP=IVON01 02070014 ! 211: IVCORR=2 02080014 ! 212: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02090014 ! 213: 1351 CONTINUE 02100014 ! 214: C 02110014 ! 215: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02120014 ! 216: 99999 CONTINUE 02130014 ! 217: WRITE (I02,90002) 02140014 ! 218: WRITE (I02,90006) 02150014 ! 219: WRITE (I02,90002) 02160014 ! 220: WRITE (I02,90002) 02170014 ! 221: WRITE (I02,90007) 02180014 ! 222: WRITE (I02,90002) 02190014 ! 223: WRITE (I02,90008) IVFAIL 02200014 ! 224: WRITE (I02,90009) IVPASS 02210014 ! 225: WRITE (I02,90010) IVDELE 02220014 ! 226: C 02230014 ! 227: C 02240014 ! 228: C TERMINATE ROUTINE EXECUTION 02250014 ! 229: STOP 02260014 ! 230: C 02270014 ! 231: C FORMAT STATEMENTS FOR PAGE HEADERS 02280014 ! 232: 90000 FORMAT (1H1) 02290014 ! 233: 90002 FORMAT (1H ) 02300014 ! 234: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02310014 ! 235: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02320014 ! 236: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02330014 ! 237: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02340014 ! 238: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02350014 ! 239: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02360014 ! 240: C 02370014 ! 241: C FORMAT STATEMENTS FOR RUN SUMMARIES 02380014 ! 242: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02390014 ! 243: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02400014 ! 244: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02410014 ! 245: C 02420014 ! 246: C FORMAT STATEMENTS FOR TEST RESULTS 02430014 ! 247: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02440014 ! 248: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02450014 ! 249: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02460014 ! 250: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02470014 ! 251: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02480014 ! 252: C 02490014 ! 253: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM014) 02500014 ! 254: END 02510014
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.