![[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 [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests|
Return to fm013.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: c ! 2: c comment section. ! 3: c ! 4: c fm013 ! 5: c ! 6: c this routine tests the fortran assigned go to statement ! 7: c as described in section 11.3 (assigned go to statement). first a ! 8: c statement label is assigned to an integer variable in the assign ! 9: c statement. secondly a branch is made in an assigned go to ! 10: c statement using the integer variable as the branch controller ! 11: c in a list of possible statement numbers to be branched to. ! 12: c ! 13: c references ! 14: c american national standard programming language fortran, ! 15: c x3.9-1978 ! 16: c ! 17: c section 10.3, statement label assignment (assign) statement ! 18: c section 11.3, assigned go to statement ! 19: c ! 20: c ! 21: c ********************************************************** ! 22: c ! 23: c a compiler validation system for the fortran language ! 24: c based on specifications as defined in american national standard ! 25: c programming language fortran x3.9-1978, has been developed by the ! 26: c federal cobol compiler testing service. the fortran compiler ! 27: c validation system (fcvs) consists of audit routines, their related ! 28: c data, and an executive system. each audit routine is a fortran ! 29: c program, subprogram or function which includes tests of specific ! 30: c language elements and supporting procedures indicating the result ! 31: c of executing these tests. ! 32: c ! 33: c this particular program/subprogram/function contains features ! 34: c found only in the subset as defined in x3.9-1978. ! 35: c ! 36: c suggestions and comments should be forwarded to - ! 37: c ! 38: c department of the navy ! 39: c federal cobol compiler testing service ! 40: c washington, d.c. 20376 ! 41: c ! 42: c ********************************************************** ! 43: c ! 44: c ! 45: c ! 46: c initialization section ! 47: c ! 48: c initialize constants ! 49: c ************** ! 50: c i01 contains the logical unit number for the card reader. ! 51: i01 = 5 ! 52: c i02 contains the logical unit number for the printer. ! 53: i02 = 6 ! 54: c system environment section ! 55: c ! 56: cx010 this card is replaced by contents of fexec x-010 control card. ! 57: c the cx010 card is for overriding the program default i01 = 5 ! 58: c (unit number for card reader). ! 59: cx011 this card is replaced by contents of fexec x-011 control card. ! 60: c the cx011 card is for systems which require additional ! 61: c fortran statements for files associated with cx010 above. ! 62: c ! 63: cx020 this card is replaced by contents of fexec x-020 control card. ! 64: c the cx020 card is for overriding the program default i02 = 6 ! 65: c (unit number for printer). ! 66: cx021 this card is replaced by contents of fexec x-021 control card. ! 67: c the cx021 card is for systems which require additional ! 68: c fortran statements for files associated with cx020 above. ! 69: c ! 70: ivpass=0 ! 71: ivfail=0 ! 72: ivdele=0 ! 73: iczero=0 ! 74: c ! 75: c write page headers ! 76: write (i02,90000) ! 77: write (i02,90001) ! 78: write (i02,90002) ! 79: write (i02, 90002) ! 80: write (i02,90003) ! 81: write (i02,90002) ! 82: write (i02,90004) ! 83: write (i02,90002) ! 84: write (i02,90011) ! 85: write (i02,90002) ! 86: write (i02,90002) ! 87: write (i02,90005) ! 88: write (i02,90006) ! 89: write (i02,90002) ! 90: ivtnum = 126 ! 91: c ! 92: c test 126 - this tests the simple assign statement in preparation ! 93: c for the assigned go to test to follow. ! 94: c the assigned go to is the simplist form of the statement. ! 95: c ! 96: c ! 97: if (iczero) 31260, 1260, 31260 ! 98: 1260 continue ! 99: assign 1263 to i ! 100: go to i, (1262,1263,1264) ! 101: 1262 icon01 = 1262 ! 102: go to 1265 ! 103: 1263 icon01 = 1263 ! 104: go to 1265 ! 105: 1264 icon01 = 1264 ! 106: 1265 continue ! 107: go to 41260 ! 108: 31260 ivdele = ivdele + 1 ! 109: write (i02,80003) ivtnum ! 110: if (iczero) 41260, 1271, 41260 ! 111: 41260 if ( icon01 - 1263 ) 21260, 11260, 21260 ! 112: 11260 ivpass = ivpass + 1 ! 113: write (i02,80001) ivtnum ! 114: go to 1271 ! 115: 21260 ivfail = ivfail + 1 ! 116: ivcomp=icon01 ! 117: ivcorr = 1263 ! 118: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 119: 1271 continue ! 120: ivtnum = 127 ! 121: c ! 122: c test 127 - this is a test of more complex branching using ! 123: c the assign and assigned go to statements. this test is not ! 124: c intended to be an example of structured programming. ! 125: c ! 126: c ! 127: if (iczero) 31270, 1270, 31270 ! 128: 1270 continue ! 129: ivon01=0 ! 130: 1272 assign 1273 to j ! 131: ivon01=ivon01+1 ! 132: go to 1276 ! 133: 1273 assign 1274 to j ! 134: ivon01=ivon01 * 10 + 2 ! 135: go to 1276 ! 136: 1274 assign 1275 to j ! 137: ivon01=ivon01 * 100 + 3 ! 138: go to 1276 ! 139: 1275 go to 1277 ! 140: 1276 go to j, ( 1272, 1273, 1274, 1275 ) ! 141: 1277 continue ! 142: go to 41270 ! 143: 31270 ivdele = ivdele + 1 ! 144: write (i02,80003) ivtnum ! 145: if (iczero) 41270, 1281, 41270 ! 146: 41270 if ( ivon01 - 1203 ) 21270, 11270, 21270 ! 147: 11270 ivpass = ivpass + 1 ! 148: write (i02,80001) ivtnum ! 149: go to 1281 ! 150: 21270 ivfail = ivfail + 1 ! 151: ivcomp=ivon01 ! 152: ivcorr=1203 ! 153: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 154: 1281 continue ! 155: ivtnum = 128 ! 156: c ! 157: c test 128 - test of the assigned go to with all of the ! 158: c statement numbers in the assigned go to list the same ! 159: c value except for one. ! 160: c ! 161: c ! 162: if (iczero) 31280, 1280, 31280 ! 163: 1280 continue ! 164: icon01=0 ! 165: assign 1283 to k ! 166: go to k, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 ) ! 167: 1282 icon01 = 0 ! 168: go to 1284 ! 169: 1283 icon01 = 1 ! 170: 1284 continue ! 171: go to 41280 ! 172: 31280 ivdele = ivdele + 1 ! 173: write (i02,80003) ivtnum ! 174: if (iczero) 41280, 1291, 41280 ! 175: 41280 if ( icon01 - 1 ) 21280, 11280, 21280 ! 176: 11280 ivpass = ivpass + 1 ! 177: write (i02,80001) ivtnum ! 178: go to 1291 ! 179: 21280 ivfail = ivfail + 1 ! 180: ivcomp=icon01 ! 181: ivcorr=1 ! 182: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 183: 1291 continue ! 184: ivtnum = 129 ! 185: c ! 186: c test 129 - this tests the assign statement in conjunction ! 187: c with the normal arithmetic assign statement. the value ! 188: c of the index for the assigned go to statement is changed by ! 189: c the combination of statements. ! 190: c ! 191: c ! 192: if (iczero) 31290, 1290, 31290 ! 193: 1290 continue ! 194: icon01=0 ! 195: assign 1292 to l ! 196: l = 1293 ! 197: assign 1294 to l ! 198: go to l, ( 1294, 1293, 1292 ) ! 199: 1292 icon01 = 0 ! 200: go to 1295 ! 201: 1293 icon01 = 0 ! 202: go to 1295 ! 203: 1294 icon01 = 1 ! 204: 1295 continue ! 205: go to 41290 ! 206: 31290 ivdele = ivdele + 1 ! 207: write (i02,80003) ivtnum ! 208: if (iczero) 41290, 1301, 41290 ! 209: 41290 if ( icon01 - 1 ) 21290, 11290, 21290 ! 210: 11290 ivpass = ivpass + 1 ! 211: write (i02,80001) ivtnum ! 212: go to 1301 ! 213: 21290 ivfail = ivfail + 1 ! 214: ivcomp=icon01 ! 215: ivcorr=1 ! 216: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 217: 1301 continue ! 218: ivtnum = 130 ! 219: c ! 220: c test 130 - this is a test of a loop using a combination of the ! 221: c assigned go to statement and the arithmetic if statement. ! 222: c the loop should be executed eleven (11) times then control ! 223: c should pass to the check of the value for ivon01. ! 224: c ! 225: c ! 226: if (iczero) 31300, 1300, 31300 ! 227: 1300 continue ! 228: ivon01=0 ! 229: 1302 assign 1302 to m ! 230: ivon01=ivon01+1 ! 231: if ( ivon01 - 10 ) 1303, 1303, 1304 ! 232: 1303 go to 1305 ! 233: 1304 assign 1306 to m ! 234: 1305 go to m, ( 1302, 1306 ) ! 235: 1306 continue ! 236: go to 41300 ! 237: 31300 ivdele = ivdele + 1 ! 238: write (i02,80003) ivtnum ! 239: if (iczero) 41300, 1311, 41300 ! 240: 41300 if ( ivon01 - 11 ) 21300, 11300, 21300 ! 241: 11300 ivpass = ivpass + 1 ! 242: write (i02,80001) ivtnum ! 243: go to 1311 ! 244: 21300 ivfail = ivfail + 1 ! 245: ivcomp=ivon01 ! 246: ivcorr=11 ! 247: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 248: 1311 continue ! 249: c ! 250: c write page footings and run summaries ! 251: 99999 continue ! 252: write (i02,90002) ! 253: write (i02,90006) ! 254: write (i02,90002) ! 255: write (i02,90002) ! 256: write (i02,90007) ! 257: write (i02,90002) ! 258: write (i02,90008) ivfail ! 259: write (i02,90009) ivpass ! 260: write (i02,90010) ivdele ! 261: c ! 262: c ! 263: c terminate routine execution ! 264: stop ! 265: c ! 266: c format statements for page headers ! 267: 90000 format (1h1) ! 268: 90002 format (1h ) ! 269: 90001 format (1h ,10x,34hfortran compiler validation system) ! 270: 90003 format (1h ,21x,11hversion 1.0) ! 271: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 272: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 273: 90006 format (1h ,5x,46h----------------------------------------------) ! 274: 90011 format (1h ,18x,17hsubset level test) ! 275: c ! 276: c format statements for run summaries ! 277: 90008 format (1h ,15x,i5,19h errors encountered) ! 278: 90009 format (1h ,15x,i5,13h tests passed) ! 279: 90010 format (1h ,15x,i5,14h tests deleted) ! 280: c ! 281: c format statements for test results ! 282: 80001 format (1h ,4x,i5,7x,4hpass) ! 283: 80002 format (1h ,4x,i5,7x,4hfail) ! 284: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 285: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 286: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 287: c ! 288: 90007 format (1h ,20x,20hend of program fm013) ! 289: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.