![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM013.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 FM013.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 00010013 ! 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. 00020013 ! 6: C 00030013 ! 7: C FM013 00040013 ! 8: C 00050013 ! 9: C THIS ROUTINE TESTS THE FORTRAN ASSIGNED GO TO STATEMENT 00060013 ! 10: C AS DESCRIBED IN SECTION 11.3 (ASSIGNED GO TO STATEMENT). FIRST A 00070013 ! 11: C STATEMENT LABEL IS ASSIGNED TO AN INTEGER VARIABLE IN THE ASSIGN 00080013 ! 12: C STATEMENT. SECONDLY A BRANCH IS MADE IN AN ASSIGNED GO TO 00090013 ! 13: C STATEMENT USING THE INTEGER VARIABLE AS THE BRANCH CONTROLLER 00100013 ! 14: C IN A LIST OF POSSIBLE STATEMENT NUMBERS TO BE BRANCHED TO. 00110013 ! 15: C 00120013 ! 16: C REFERENCES 00130013 ! 17: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140013 ! 18: C X3.9-1978 00150013 ! 19: C 00160013 ! 20: C SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN) STATEMENT 00170013 ! 21: C SECTION 11.3, ASSIGNED GO TO STATEMENT 00180013 ! 22: C 00190013 ! 23: C 00200013 ! 24: C ********************************************************** 00210013 ! 25: C 00220013 ! 26: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00230013 ! 27: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00240013 ! 28: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250013 ! 29: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00260013 ! 30: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270013 ! 31: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00280013 ! 32: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00290013 ! 33: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300013 ! 34: C OF EXECUTING THESE TESTS. 00310013 ! 35: C 00320013 ! 36: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330013 ! 37: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00340013 ! 38: C 00350013 ! 39: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00360013 ! 40: C 00370013 ! 41: C DEPARTMENT OF THE NAVY 00380013 ! 42: C FEDERAL COBOL COMPILER TESTING SERVICE 00390013 ! 43: C WASHINGTON, D.C. 20376 00400013 ! 44: C 00410013 ! 45: C ********************************************************** 00420013 ! 46: C 00430013 ! 47: C 00440013 ! 48: C 00450013 ! 49: C INITIALIZATION SECTION 00460013 ! 50: C 00470013 ! 51: C INITIALIZE CONSTANTS 00480013 ! 52: C ************** 00490013 ! 53: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00500013 ! 54: I01 = 5 00510013 ! 55: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00520013 ! 56: I02 = 6 00530013 ! 57: C SYSTEM ENVIRONMENT SECTION 00540013 ! 58: C 00550013 ! 59: I01 = 5 00560013 ! 60: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00570013 ! 61: C (UNIT NUMBER FOR CARD READER). 00580013 ! 62: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590013 ! 63: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00600013 ! 64: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00610013 ! 65: C 00620013 ! 66: I02 = 6 00630013 ! 67: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00640013 ! 68: C (UNIT NUMBER FOR PRINTER). 00650013 ! 69: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660013 ! 70: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670013 ! 71: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00680013 ! 72: C 00690013 ! 73: IVPASS=0 00700013 ! 74: IVFAIL=0 00710013 ! 75: IVDELE=0 00720013 ! 76: ICZERO=0 00730013 ! 77: C 00740013 ! 78: C WRITE PAGE HEADERS 00750013 ! 79: WRITE (I02,90000) 00760013 ! 80: WRITE (I02,90001) 00770013 ! 81: WRITE (I02,90002) 00780013 ! 82: WRITE (I02, 90002) 00790013 ! 83: WRITE (I02,90003) 00800013 ! 84: WRITE (I02,90002) 00810013 ! 85: WRITE (I02,90004) 00820013 ! 86: WRITE (I02,90002) 00830013 ! 87: WRITE (I02,90011) 00840013 ! 88: WRITE (I02,90002) 00850013 ! 89: WRITE (I02,90002) 00860013 ! 90: WRITE (I02,90005) 00870013 ! 91: WRITE (I02,90006) 00880013 ! 92: WRITE (I02,90002) 00890013 ! 93: IVTNUM = 126 00900013 ! 94: C 00910013 ! 95: C TEST 126 - THIS TESTS THE SIMPLE ASSIGN STATEMENT IN PREPARATION00920013 ! 96: C FOR THE ASSIGNED GO TO TEST TO FOLLOW. 00930013 ! 97: C THE ASSIGNED GO TO IS THE SIMPLIST FORM OF THE STATEMENT. 00940013 ! 98: C 00950013 ! 99: C 00960013 ! 100: IF (ICZERO) 31260, 1260, 31260 00970013 ! 101: 1260 CONTINUE 00980013 ! 102: ASSIGN 1263 TO I 00990013 ! 103: GO TO I, (1262,1263,1264) 01000013 ! 104: 1262 ICON01 = 1262 01010013 ! 105: GO TO 1265 01020013 ! 106: 1263 ICON01 = 1263 01030013 ! 107: GO TO 1265 01040013 ! 108: 1264 ICON01 = 1264 01050013 ! 109: 1265 CONTINUE 01060013 ! 110: GO TO 41260 01070013 ! 111: 31260 IVDELE = IVDELE + 1 01080013 ! 112: WRITE (I02,80003) IVTNUM 01090013 ! 113: IF (ICZERO) 41260, 1271, 41260 01100013 ! 114: 41260 IF ( ICON01 - 1263 ) 21260, 11260, 21260 01110013 ! 115: 11260 IVPASS = IVPASS + 1 01120013 ! 116: WRITE (I02,80001) IVTNUM 01130013 ! 117: GO TO 1271 01140013 ! 118: 21260 IVFAIL = IVFAIL + 1 01150013 ! 119: IVCOMP=ICON01 01160013 ! 120: IVCORR = 1263 01170013 ! 121: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01180013 ! 122: 1271 CONTINUE 01190013 ! 123: IVTNUM = 127 01200013 ! 124: C 01210013 ! 125: C TEST 127 - THIS IS A TEST OF MORE COMPLEX BRANCHING USING 01220013 ! 126: C THE ASSIGN AND ASSIGNED GO TO STATEMENTS. THIS TEST IS NOT 01230013 ! 127: C INTENDED TO BE AN EXAMPLE OF STRUCTURED PROGRAMMING. 01240013 ! 128: C 01250013 ! 129: C 01260013 ! 130: IF (ICZERO) 31270, 1270, 31270 01270013 ! 131: 1270 CONTINUE 01280013 ! 132: IVON01=0 01290013 ! 133: 1272 ASSIGN 1273 TO J 01300013 ! 134: IVON01=IVON01+1 01310013 ! 135: GO TO 1276 01320013 ! 136: 1273 ASSIGN 1274 TO J 01330013 ! 137: IVON01=IVON01 * 10 + 2 01340013 ! 138: GO TO 1276 01350013 ! 139: 1274 ASSIGN 1275 TO J 01360013 ! 140: IVON01=IVON01 * 100 + 3 01370013 ! 141: GO TO 1276 01380013 ! 142: 1275 GO TO 1277 01390013 ! 143: 1276 GO TO J, ( 1272, 1273, 1274, 1275 ) 01400013 ! 144: 1277 CONTINUE 01410013 ! 145: GO TO 41270 01420013 ! 146: 31270 IVDELE = IVDELE + 1 01430013 ! 147: WRITE (I02,80003) IVTNUM 01440013 ! 148: IF (ICZERO) 41270, 1281, 41270 01450013 ! 149: 41270 IF ( IVON01 - 1203 ) 21270, 11270, 21270 01460013 ! 150: 11270 IVPASS = IVPASS + 1 01470013 ! 151: WRITE (I02,80001) IVTNUM 01480013 ! 152: GO TO 1281 01490013 ! 153: 21270 IVFAIL = IVFAIL + 1 01500013 ! 154: IVCOMP=IVON01 01510013 ! 155: IVCORR=1203 01520013 ! 156: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01530013 ! 157: 1281 CONTINUE 01540013 ! 158: IVTNUM = 128 01550013 ! 159: C 01560013 ! 160: C TEST 128 - TEST OF THE ASSIGNED GO TO WITH ALL OF THE 01570013 ! 161: C STATEMENT NUMBERS IN THE ASSIGNED GO TO LIST THE SAME 01580013 ! 162: C VALUE EXCEPT FOR ONE. 01590013 ! 163: C 01600013 ! 164: C 01610013 ! 165: IF (ICZERO) 31280, 1280, 31280 01620013 ! 166: 1280 CONTINUE 01630013 ! 167: ICON01=0 01640013 ! 168: ASSIGN 1283 TO K 01650013 ! 169: GO TO K, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 ) 01660013 ! 170: 1282 ICON01 = 0 01670013 ! 171: GO TO 1284 01680013 ! 172: 1283 ICON01 = 1 01690013 ! 173: 1284 CONTINUE 01700013 ! 174: GO TO 41280 01710013 ! 175: 31280 IVDELE = IVDELE + 1 01720013 ! 176: WRITE (I02,80003) IVTNUM 01730013 ! 177: IF (ICZERO) 41280, 1291, 41280 01740013 ! 178: 41280 IF ( ICON01 - 1 ) 21280, 11280, 21280 01750013 ! 179: 11280 IVPASS = IVPASS + 1 01760013 ! 180: WRITE (I02,80001) IVTNUM 01770013 ! 181: GO TO 1291 01780013 ! 182: 21280 IVFAIL = IVFAIL + 1 01790013 ! 183: IVCOMP=ICON01 01800013 ! 184: IVCORR=1 01810013 ! 185: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01820013 ! 186: 1291 CONTINUE 01830013 ! 187: IVTNUM = 129 01840013 ! 188: C 01850013 ! 189: C TEST 129 - THIS TESTS THE ASSIGN STATEMENT IN CONJUNCTION 01860013 ! 190: C WITH THE NORMAL ARITHMETIC ASSIGN STATEMENT. THE VALUE 01870013 ! 191: C OF THE INDEX FOR THE ASSIGNED GO TO STATEMENT IS CHANGED BY 01880013 ! 192: C THE COMBINATION OF STATEMENTS. 01890013 ! 193: C 01900013 ! 194: C 01910013 ! 195: IF (ICZERO) 31290, 1290, 31290 01920013 ! 196: 1290 CONTINUE 01930013 ! 197: ICON01=0 01940013 ! 198: ASSIGN 1292 TO L 01950013 ! 199: L = 1293 01960013 ! 200: ASSIGN 1294 TO L 01970013 ! 201: GO TO L, ( 1294, 1293, 1292 ) 01980013 ! 202: 1292 ICON01 = 0 01990013 ! 203: GO TO 1295 02000013 ! 204: 1293 ICON01 = 0 02010013 ! 205: GO TO 1295 02020013 ! 206: 1294 ICON01 = 1 02030013 ! 207: 1295 CONTINUE 02040013 ! 208: GO TO 41290 02050013 ! 209: 31290 IVDELE = IVDELE + 1 02060013 ! 210: WRITE (I02,80003) IVTNUM 02070013 ! 211: IF (ICZERO) 41290, 1301, 41290 02080013 ! 212: 41290 IF ( ICON01 - 1 ) 21290, 11290, 21290 02090013 ! 213: 11290 IVPASS = IVPASS + 1 02100013 ! 214: WRITE (I02,80001) IVTNUM 02110013 ! 215: GO TO 1301 02120013 ! 216: 21290 IVFAIL = IVFAIL + 1 02130013 ! 217: IVCOMP=ICON01 02140013 ! 218: IVCORR=1 02150013 ! 219: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02160013 ! 220: 1301 CONTINUE 02170013 ! 221: IVTNUM = 130 02180013 ! 222: C 02190013 ! 223: C TEST 130 - THIS IS A TEST OF A LOOP USING A COMBINATION OF THE 02200013 ! 224: C ASSIGNED GO TO STATEMENT AND THE ARITHMETIC IF STATEMENT. 02210013 ! 225: C THE LOOP SHOULD BE EXECUTED ELEVEN (11) TIMES THEN CONTROL 02220013 ! 226: C SHOULD PASS TO THE CHECK OF THE VALUE FOR IVON01. 02230013 ! 227: C 02240013 ! 228: C 02250013 ! 229: IF (ICZERO) 31300, 1300, 31300 02260013 ! 230: 1300 CONTINUE 02270013 ! 231: IVON01=0 02280013 ! 232: 1302 ASSIGN 1302 TO M 02290013 ! 233: IVON01=IVON01+1 02300013 ! 234: IF ( IVON01 - 10 ) 1303, 1303, 1304 02310013 ! 235: 1303 GO TO 1305 02320013 ! 236: 1304 ASSIGN 1306 TO M 02330013 ! 237: 1305 GO TO M, ( 1302, 1306 ) 02340013 ! 238: 1306 CONTINUE 02350013 ! 239: GO TO 41300 02360013 ! 240: 31300 IVDELE = IVDELE + 1 02370013 ! 241: WRITE (I02,80003) IVTNUM 02380013 ! 242: IF (ICZERO) 41300, 1311, 41300 02390013 ! 243: 41300 IF ( IVON01 - 11 ) 21300, 11300, 21300 02400013 ! 244: 11300 IVPASS = IVPASS + 1 02410013 ! 245: WRITE (I02,80001) IVTNUM 02420013 ! 246: GO TO 1311 02430013 ! 247: 21300 IVFAIL = IVFAIL + 1 02440013 ! 248: IVCOMP=IVON01 02450013 ! 249: IVCORR=11 02460013 ! 250: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02470013 ! 251: 1311 CONTINUE 02480013 ! 252: C 02490013 ! 253: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02500013 ! 254: 99999 CONTINUE 02510013 ! 255: WRITE (I02,90002) 02520013 ! 256: WRITE (I02,90006) 02530013 ! 257: WRITE (I02,90002) 02540013 ! 258: WRITE (I02,90002) 02550013 ! 259: WRITE (I02,90007) 02560013 ! 260: WRITE (I02,90002) 02570013 ! 261: WRITE (I02,90008) IVFAIL 02580013 ! 262: WRITE (I02,90009) IVPASS 02590013 ! 263: WRITE (I02,90010) IVDELE 02600013 ! 264: C 02610013 ! 265: C 02620013 ! 266: C TERMINATE ROUTINE EXECUTION 02630013 ! 267: STOP 02640013 ! 268: C 02650013 ! 269: C FORMAT STATEMENTS FOR PAGE HEADERS 02660013 ! 270: 90000 FORMAT (1H1) 02670013 ! 271: 90002 FORMAT (1H ) 02680013 ! 272: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02690013 ! 273: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02700013 ! 274: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02710013 ! 275: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02720013 ! 276: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02730013 ! 277: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02740013 ! 278: C 02750013 ! 279: C FORMAT STATEMENTS FOR RUN SUMMARIES 02760013 ! 280: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02770013 ! 281: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02780013 ! 282: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02790013 ! 283: C 02800013 ! 284: C FORMAT STATEMENTS FOR TEST RESULTS 02810013 ! 285: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02820013 ! 286: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02830013 ! 287: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02840013 ! 288: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02850013 ! 289: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02860013 ! 290: C 02870013 ! 291: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM013) 02880013 ! 292: END 02890013
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.