|
|
1.1 ! root 1: c ! 2: c comment section. ! 3: c ! 4: c fm014 ! 5: c ! 6: c this routine tests the fortran computed go to statement. ! 7: c because the form of the computed go to is so straightforward, the ! 8: c tests mainly relate to the range of possible statement numbers ! 9: c which are used. ! 10: c ! 11: c references ! 12: c american national standard programming language fortran, ! 13: c x3.9-1978 ! 14: c ! 15: c section 11.2, computed go to statement ! 16: c ! 17: c ! 18: c ********************************************************** ! 19: c ! 20: c a compiler validation system for the fortran language ! 21: c based on specifications as defined in american national standard ! 22: c programming language fortran x3.9-1978, has been developed by the ! 23: c federal cobol compiler testing service. the fortran compiler ! 24: c validation system (fcvs) consists of audit routines, their related ! 25: c data, and an executive system. each audit routine is a fortran ! 26: c program, subprogram or function which includes tests of specific ! 27: c language elements and supporting procedures indicating the result ! 28: c of executing these tests. ! 29: c ! 30: c this particular program/subprogram/function contains features ! 31: c found only in the subset as defined in x3.9-1978. ! 32: c ! 33: c suggestions and comments should be forwarded to - ! 34: c ! 35: c department of the navy ! 36: c federal cobol compiler testing service ! 37: c washington, d.c. 20376 ! 38: c ! 39: c ********************************************************** ! 40: c ! 41: c ! 42: c ! 43: c initialization section ! 44: c ! 45: c initialize constants ! 46: c ************** ! 47: c i01 contains the logical unit number for the card reader. ! 48: i01 = 5 ! 49: c i02 contains the logical unit number for the printer. ! 50: i02 = 6 ! 51: c system environment section ! 52: c ! 53: cx010 this card is replaced by contents of fexec x-010 control card. ! 54: c the cx010 card is for overriding the program default i01 = 5 ! 55: c (unit number for card reader). ! 56: cx011 this card is replaced by contents of fexec x-011 control card. ! 57: c the cx011 card is for systems which require additional ! 58: c fortran statements for files associated with cx010 above. ! 59: c ! 60: cx020 this card is replaced by contents of fexec x-020 control card. ! 61: c the cx020 card is for overriding the program default i02 = 6 ! 62: c (unit number for printer). ! 63: cx021 this card is replaced by contents of fexec x-021 control card. ! 64: c the cx021 card is for systems which require additional ! 65: c fortran statements for files associated with cx020 above. ! 66: c ! 67: ivpass=0 ! 68: ivfail=0 ! 69: ivdele=0 ! 70: iczero=0 ! 71: c ! 72: c write page headers ! 73: write (i02,90000) ! 74: write (i02,90001) ! 75: write (i02,90002) ! 76: write (i02, 90002) ! 77: write (i02,90003) ! 78: write (i02,90002) ! 79: write (i02,90004) ! 80: write (i02,90002) ! 81: write (i02,90011) ! 82: write (i02,90002) ! 83: write (i02,90002) ! 84: write (i02,90005) ! 85: write (i02,90006) ! 86: write (i02,90002) ! 87: ivtnum = 131 ! 88: c ! 89: c test 131 - test of the simplist form of the computed go to ! 90: c statement with three possible branches. ! 91: c ! 92: c ! 93: if (iczero) 31310, 1310, 31310 ! 94: 1310 continue ! 95: icon01=0 ! 96: i=3 ! 97: go to ( 1312, 1313, 1314 ), i ! 98: 1312 icon01 = 1312 ! 99: go to 1315 ! 100: 1313 icon01 = 1313 ! 101: go to 1315 ! 102: 1314 icon01 = 1314 ! 103: 1315 continue ! 104: go to 41310 ! 105: 31310 ivdele = ivdele + 1 ! 106: write (i02,80003) ivtnum ! 107: if (iczero) 41310, 1321, 41310 ! 108: 41310 if ( icon01 - 1314 ) 21310, 11310, 21310 ! 109: 11310 ivpass = ivpass + 1 ! 110: write (i02,80001) ivtnum ! 111: go to 1321 ! 112: 21310 ivfail = ivfail + 1 ! 113: ivcomp=icon01 ! 114: ivcorr = 1314 ! 115: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 116: 1321 continue ! 117: ivtnum = 132 ! 118: c ! 119: c test 132 - this tests the computed go to in conjunction with the ! 120: c the unconditional go to statement. this test is not ! 121: c intended to be an example of good structured programming. ! 122: c ! 123: c ! 124: if (iczero) 31320, 1320, 31320 ! 125: 1320 continue ! 126: ivon01=0 ! 127: j=1 ! 128: go to 1326 ! 129: 1322 j = 2 ! 130: ivon01=ivon01+2 ! 131: go to 1326 ! 132: 1323 j = 3 ! 133: ivon01=ivon01 * 10 + 3 ! 134: go to 1326 ! 135: 1324 j = 4 ! 136: ivon01=ivon01 * 100 + 4 ! 137: go to 1326 ! 138: 1325 ivon01 = ivon01 + 1 ! 139: go to 1327 ! 140: 1326 go to ( 1322, 1323, 1324, 1325, 1326 ), j ! 141: 1327 continue ! 142: go to 41320 ! 143: 31320 ivdele = ivdele + 1 ! 144: write (i02,80003) ivtnum ! 145: if (iczero) 41320, 1331, 41320 ! 146: 41320 if ( ivon01 - 2305 ) 21320, 11320, 21320 ! 147: 11320 ivpass = ivpass + 1 ! 148: write (i02,80001) ivtnum ! 149: go to 1331 ! 150: 21320 ivfail = ivfail + 1 ! 151: ivcomp=ivon01 ! 152: ivcorr=2305 ! 153: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 154: 1331 continue ! 155: ivtnum = 133 ! 156: c ! 157: c test 133 - this is a test of the computed go to statement with ! 158: c a single statement label as the list of possible branches. ! 159: c ! 160: c ! 161: if (iczero) 31330, 1330, 31330 ! 162: 1330 continue ! 163: ivon01=0 ! 164: k=1 ! 165: go to ( 1332 ), k ! 166: 1332 ivon01 = 1 ! 167: go to 41330 ! 168: 31330 ivdele = ivdele + 1 ! 169: write (i02,80003) ivtnum ! 170: if (iczero) 41330, 1341, 41330 ! 171: 41330 if ( ivon01 - 1 ) 21330, 11330, 21330 ! 172: 11330 ivpass = ivpass + 1 ! 173: write (i02,80001) ivtnum ! 174: go to 1341 ! 175: 21330 ivfail = ivfail + 1 ! 176: ivcomp=ivon01 ! 177: ivcorr=1 ! 178: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 179: 1341 continue ! 180: ivtnum = 134 ! 181: c ! 182: c test 134 - this is a test of five (5) digit statement numbers ! 183: c which exceed the integer 32767 used in the computed go to ! 184: c statement with three possible branches. ! 185: c ! 186: c ! 187: if (iczero) 31340, 1340, 31340 ! 188: 1340 continue ! 189: ivon01=0 ! 190: l=2 ! 191: go to ( 99991, 99992, 99993 ), l ! 192: 99991 ivon01=1 ! 193: go to 1342 ! 194: 99992 ivon01=2 ! 195: go to 1342 ! 196: 99993 ivon01=3 ! 197: 1342 continue ! 198: go to 41340 ! 199: 31340 ivdele = ivdele + 1 ! 200: write (i02,80003) ivtnum ! 201: if (iczero) 41340, 1351, 41340 ! 202: 41340 if ( ivon01 - 2 ) 21340, 11340, 21340 ! 203: 11340 ivpass = ivpass + 1 ! 204: write (i02,80001) ivtnum ! 205: go to 1351 ! 206: 21340 ivfail = ivfail + 1 ! 207: ivcomp=ivon01 ! 208: ivcorr=2 ! 209: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 210: 1351 continue ! 211: c ! 212: c write page footings and run summaries ! 213: 99999 continue ! 214: write (i02,90002) ! 215: write (i02,90006) ! 216: write (i02,90002) ! 217: write (i02,90002) ! 218: write (i02,90007) ! 219: write (i02,90002) ! 220: write (i02,90008) ivfail ! 221: write (i02,90009) ivpass ! 222: write (i02,90010) ivdele ! 223: c ! 224: c ! 225: c terminate routine execution ! 226: stop ! 227: c ! 228: c format statements for page headers ! 229: 90000 format (1h1) ! 230: 90002 format (1h ) ! 231: 90001 format (1h ,10x,34hfortran compiler validation system) ! 232: 90003 format (1h ,21x,11hversion 1.0) ! 233: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 234: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 235: 90006 format (1h ,5x,46h----------------------------------------------) ! 236: 90011 format (1h ,18x,17hsubset level test) ! 237: c ! 238: c format statements for run summaries ! 239: 90008 format (1h ,15x,i5,19h errors encountered) ! 240: 90009 format (1h ,15x,i5,13h tests passed) ! 241: 90010 format (1h ,15x,i5,14h tests deleted) ! 242: c ! 243: c format statements for test results ! 244: 80001 format (1h ,4x,i5,7x,4hpass) ! 245: 80002 format (1h ,4x,i5,7x,4hfail) ! 246: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 247: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 248: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 249: c ! 250: 90007 format (1h ,20x,20hend of program fm014) ! 251: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.