![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm056.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 fm056.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 fm056 ! 5: c ! 6: c fm056 is a main which tests the argument passing linkage of ! 7: c a 2 level nested subroutine and an external function reference. ! 8: c the main program fm056 calls subroutine fs057 passing one ! 9: c argument. subroutine fs057 calls subroutine fs058 passing two ! 10: c arguments. subroutine fs058 references external function ff059 ! 11: c passing 3 arguments. function ff059 adds the values of the 3 ! 12: c arguments together. subroutine fs057 and fs058 then merely ! 13: c return the result to fm056 in the first argument. ! 14: c ! 15: c the values of the arguments that are passed to each ! 16: c subprogram and function, and returned to the calling or ! 17: c referencing program are saved in an integer array. fm056 then ! 18: c uses these values to test the compiler's argument passing ! 19: c capabilities. ! 20: c ! 21: c references ! 22: c american national standard programming language fortran, ! 23: c x3.9-1978 ! 24: c ! 25: c section 15.6.2, subroutine reference ! 26: common iacn11 (12) ! 27: c ! 28: c ********************************************************** ! 29: c ! 30: c a compiler validation system for the fortran language ! 31: c based on specifications as defined in american national standard ! 32: c programming language fortran x3.9-1978, has been developed by the ! 33: c federal cobol compiler testing service. the fortran compiler ! 34: c validation system (fcvs) consists of audit routines, their related ! 35: c data, and an executive system. each audit routine is a fortran ! 36: c program, subprogram or function which includes tests of specific ! 37: c language elements and supporting procedures indicating the result ! 38: c of executing these tests. ! 39: c ! 40: c this particular program/subprogram/function contains features ! 41: c found only in the subset as defined in x3.9-1978. ! 42: c ! 43: c suggestions and comments should be forwarded to - ! 44: c ! 45: c department of the navy ! 46: c federal cobol compiler testing service ! 47: c washington, d.c. 20376 ! 48: c ! 49: c ********************************************************** ! 50: c ! 51: c ! 52: c ! 53: c initialization section ! 54: c ! 55: c initialize constants ! 56: c ************** ! 57: c i01 contains the logical unit number for the card reader. ! 58: i01 = 5 ! 59: c i02 contains the logical unit number for the printer. ! 60: i02 = 6 ! 61: c system environment section ! 62: c ! 63: cx010 this card is replaced by contents of fexec x-010 control card. ! 64: c the cx010 card is for overriding the program default i01 = 5 ! 65: c (unit number for card reader). ! 66: cx011 this card is replaced by contents of fexec x-011 control card. ! 67: c the cx011 card is for systems which require additional ! 68: c fortran statements for files associated with cx010 above. ! 69: c ! 70: cx020 this card is replaced by contents of fexec x-020 control card. ! 71: c the cx020 card is for overriding the program default i02 = 6 ! 72: c (unit number for printer). ! 73: cx021 this card is replaced by contents of fexec x-021 control card. ! 74: c the cx021 card is for systems which require additional ! 75: c fortran statements for files associated with cx020 above. ! 76: c ! 77: ivpass=0 ! 78: ivfail=0 ! 79: ivdele=0 ! 80: iczero=0 ! 81: c ! 82: c write page headers ! 83: write (i02,90000) ! 84: write (i02,90001) ! 85: write (i02,90002) ! 86: write (i02, 90002) ! 87: write (i02,90003) ! 88: write (i02,90002) ! 89: write (i02,90004) ! 90: write (i02,90002) ! 91: write (i02,90011) ! 92: write (i02,90002) ! 93: write (i02,90002) ! 94: write (i02,90005) ! 95: write (i02,90006) ! 96: write (i02,90002) ! 97: c ! 98: c test section ! 99: c ! 100: c subroutine subprogram ! 101: c ! 102: ivon01 = 5 ! 103: call fs057 (ivon01) ! 104: iacn11 (12) = ivon01 ! 105: ivtnum = 430 ! 106: c ! 107: c **** test 430 **** ! 108: c ! 109: c test 430 tests the value of the argument received by fs057 from ! 110: c a fm056 call to fs057 ! 111: c ! 112: if (iczero) 34300, 4300, 34300 ! 113: 4300 continue ! 114: ivcomp = iacn11 (1) ! 115: go to 44300 ! 116: 34300 ivdele = ivdele + 1 ! 117: write (i02,80003) ivtnum ! 118: if (iczero) 44300, 4311, 44300 ! 119: 44300 if (ivcomp - 5) 24300,14300,24300 ! 120: 14300 ivpass = ivpass + 1 ! 121: write (i02,80001) ivtnum ! 122: go to 4311 ! 123: 24300 ivfail = ivfail + 1 ! 124: ivcorr = 5 ! 125: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 126: 4311 continue ! 127: ivtnum = 431 ! 128: c ! 129: c **** test 431 **** ! 130: c ! 131: c test 431 tests the value of the second argument that was passed ! 132: c from a fs057 call to fs058 ! 133: c ! 134: c ! 135: if (iczero) 34310, 4310, 34310 ! 136: 4310 continue ! 137: ivcomp = iacn11 (2) ! 138: go to 44310 ! 139: 34310 ivdele = ivdele + 1 ! 140: write (i02,80003) ivtnum ! 141: if (iczero) 44310, 4321, 44310 ! 142: 44310 if (ivcomp - 4) 24310,14310,24310 ! 143: 14310 ivpass = ivpass + 1 ! 144: write (i02,80001) ivtnum ! 145: go to 4321 ! 146: 24310 ivfail = ivfail + 1 ! 147: ivcorr = 4 ! 148: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 149: 4321 continue ! 150: ivtnum = 432 ! 151: c ! 152: c **** test 432 **** ! 153: c ! 154: c test 432 tests the value of the first argument received by fs058 ! 155: c from a fs057 call to fs058 ! 156: c ! 157: c ! 158: if (iczero) 34320, 4320, 34320 ! 159: 4320 continue ! 160: ivcomp = iacn11 (3) ! 161: go to 44320 ! 162: 34320 ivdele = ivdele + 1 ! 163: write (i02,80003) ivtnum ! 164: if (iczero) 44320, 4331, 44320 ! 165: 44320 if (ivcomp - 5) 24320,14320,24320 ! 166: 14320 ivpass = ivpass + 1 ! 167: write (i02,80001) ivtnum ! 168: go to 4331 ! 169: 24320 ivfail = ivfail + 1 ! 170: ivcorr = 5 ! 171: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 172: 4331 continue ! 173: ivtnum = 433 ! 174: c ! 175: c **** test 433 **** ! 176: c ! 177: c test 433 tests the value of the second argument received by fs058 ! 178: c from a fs057 call to fs058 ! 179: c ! 180: c ! 181: if (iczero) 34330, 4330, 34330 ! 182: 4330 continue ! 183: ivcomp = iacn11 (4) ! 184: go to 44330 ! 185: 34330 ivdele = ivdele + 1 ! 186: write (i02,80003) ivtnum ! 187: if (iczero) 44330, 4341, 44330 ! 188: 44330 if (ivcomp - 4) 24330,14330,24330 ! 189: 14330 ivpass = ivpass + 1 ! 190: write (i02,80001) ivtnum ! 191: go to 4341 ! 192: 24330 ivfail = ivfail + 1 ! 193: ivcorr = 4 ! 194: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 195: 4341 continue ! 196: ivtnum = 434 ! 197: c ! 198: c **** test 434 **** ! 199: c ! 200: c test 434 tests the value of the third argument that was passed ! 201: c from a fs058 reference of function ff059 ! 202: c ! 203: c ! 204: if (iczero) 34340, 4340, 34340 ! 205: 4340 continue ! 206: ivcomp = iacn11 (5) ! 207: go to 44340 ! 208: 34340 ivdele = ivdele + 1 ! 209: write (i02,80003) ivtnum ! 210: if (iczero) 44340, 4351, 44340 ! 211: 44340 if (ivcomp - 3) 24340,14340,24340 ! 212: 14340 ivpass = ivpass + 1 ! 213: write (i02,80001) ivtnum ! 214: go to 4351 ! 215: 24340 ivfail = ivfail + 1 ! 216: ivcorr = 3 ! 217: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 218: 4351 continue ! 219: ivtnum = 435 ! 220: c ! 221: c **** test 435 **** ! 222: c ! 223: c test 435 tests the value of the first argument received by ff059 ! 224: c from a fs058 reference of function ff059 ! 225: c ! 226: c ! 227: if (iczero) 34350, 4350, 34350 ! 228: 4350 continue ! 229: ivcomp = iacn11 (6) ! 230: go to 44350 ! 231: 34350 ivdele = ivdele + 1 ! 232: write (i02,80003) ivtnum ! 233: if (iczero) 44350, 4361, 44350 ! 234: 44350 if (ivcomp - 5) 24350,14350,24350 ! 235: 14350 ivpass = ivpass + 1 ! 236: write (i02,80001) ivtnum ! 237: go to 4361 ! 238: 24350 ivfail = ivfail + 1 ! 239: ivcorr = 5 ! 240: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 241: 4361 continue ! 242: ivtnum = 436 ! 243: c ! 244: c **** test 436 **** ! 245: c ! 246: c test 436 tests the value of the second argument received by ff059 ! 247: c from a fs058 reference of function ff059 ! 248: c ! 249: c ! 250: if (iczero) 34360, 4360, 34360 ! 251: 4360 continue ! 252: ivcomp = iacn11 (7) ! 253: go to 44360 ! 254: 34360 ivdele = ivdele + 1 ! 255: write (i02,80003) ivtnum ! 256: if (iczero) 44360, 4371, 44360 ! 257: 44360 if (ivcomp - 4) 24360,14360,24360 ! 258: 14360 ivpass = ivpass + 1 ! 259: write (i02,80001) ivtnum ! 260: go to 4371 ! 261: 24360 ivfail = ivfail + 1 ! 262: ivcorr = 4 ! 263: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 264: 4371 continue ! 265: ivtnum = 437 ! 266: c ! 267: c **** test 437 **** ! 268: c ! 269: c test 437 tests the value of the third argument received by ff059 ! 270: c from a fs058 reference of function ff059 ! 271: c ! 272: c ! 273: if (iczero) 34370, 4370, 34370 ! 274: 4370 continue ! 275: ivcomp = iacn11 (8) ! 276: go to 44370 ! 277: 34370 ivdele = ivdele + 1 ! 278: write (i02,80003) ivtnum ! 279: if (iczero) 44370, 4381, 44370 ! 280: 44370 if (ivcomp - 3) 24370,14370,24370 ! 281: 14370 ivpass = ivpass + 1 ! 282: write (i02,80001) ivtnum ! 283: go to 4381 ! 284: 24370 ivfail = ivfail + 1 ! 285: ivcorr = 3 ! 286: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 287: 4381 continue ! 288: ivtnum = 438 ! 289: c ! 290: c **** test 438 **** ! 291: c ! 292: c test 438 tests the value of the function determined by ff059 ! 293: c ! 294: c ! 295: if (iczero) 34380, 4380, 34380 ! 296: 4380 continue ! 297: ivcomp = iacn11 (9) ! 298: go to 44380 ! 299: 34380 ivdele = ivdele + 1 ! 300: write (i02,80003) ivtnum ! 301: if (iczero) 44380, 4391, 44380 ! 302: 44380 if (ivcomp - 12) 24380,14380,24380 ! 303: 14380 ivpass = ivpass + 1 ! 304: write (i02,80001) ivtnum ! 305: go to 4391 ! 306: 24380 ivfail = ivfail + 1 ! 307: ivcorr = 12 ! 308: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 309: 4391 continue ! 310: ivtnum = 439 ! 311: c ! 312: c **** test 439 **** ! 313: c ! 314: c test 439 tests the value of the function returned to fs058 by ! 315: c ff059 ! 316: c ! 317: c ! 318: if (iczero) 34390, 4390, 34390 ! 319: 4390 continue ! 320: ivcomp = iacn11 (10) ! 321: go to 44390 ! 322: 34390 ivdele = ivdele + 1 ! 323: write (i02,80003) ivtnum ! 324: if (iczero) 44390, 4401, 44390 ! 325: 44390 if (ivcomp - 12) 24390,14390,24390 ! 326: 14390 ivpass = ivpass + 1 ! 327: write (i02,80001) ivtnum ! 328: go to 4401 ! 329: 24390 ivfail = ivfail + 1 ! 330: ivcorr = 12 ! 331: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 332: 4401 continue ! 333: ivtnum = 440 ! 334: c ! 335: c **** test 440 **** ! 336: c ! 337: c test 440 tests the value of the first argument returned to fs057 ! 338: c by fs058 ! 339: c ! 340: if (iczero) 34400, 4400, 34400 ! 341: 4400 continue ! 342: ivcomp = iacn11 (11) ! 343: go to 44400 ! 344: 34400 ivdele = ivdele + 1 ! 345: write (i02,80003) ivtnum ! 346: if (iczero) 44400, 4411, 44400 ! 347: 44400 if (ivcomp - 12) 24400,14400,24400 ! 348: 14400 ivpass = ivpass + 1 ! 349: write (i02,80001) ivtnum ! 350: go to 4411 ! 351: 24400 ivfail = ivfail + 1 ! 352: ivcorr = 12 ! 353: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 354: 4411 continue ! 355: ivtnum = 441 ! 356: c ! 357: c **** test 441 **** ! 358: c ! 359: c test 441 tests the value of the first argument returned to fm056 ! 360: c by fs057 ! 361: c ! 362: c ! 363: if (iczero) 34410, 4410, 34410 ! 364: 4410 continue ! 365: ivcomp = iacn11 (12) ! 366: go to 44410 ! 367: 34410 ivdele = ivdele + 1 ! 368: write (i02,80003) ivtnum ! 369: if (iczero) 44410, 4421, 44410 ! 370: 44410 if (ivcomp - 12) 24410,14410,24410 ! 371: 14410 ivpass = ivpass + 1 ! 372: write (i02,80001) ivtnum ! 373: go to 4421 ! 374: 24410 ivfail = ivfail + 1 ! 375: ivcorr = 12 ! 376: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 377: 4421 continue ! 378: c ! 379: c write page footings and run summaries ! 380: 99999 continue ! 381: write (i02,90002) ! 382: write (i02,90006) ! 383: write (i02,90002) ! 384: write (i02,90002) ! 385: write (i02,90007) ! 386: write (i02,90002) ! 387: write (i02,90008) ivfail ! 388: write (i02,90009) ivpass ! 389: write (i02,90010) ivdele ! 390: c ! 391: c ! 392: c terminate routine execution ! 393: stop ! 394: c ! 395: c format statements for page headers ! 396: 90000 format (1h1) ! 397: 90002 format (1h ) ! 398: 90001 format (1h ,10x,34hfortran compiler validation system) ! 399: 90003 format (1h ,21x,11hversion 1.0) ! 400: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 401: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 402: 90006 format (1h ,5x,46h----------------------------------------------) ! 403: 90011 format (1h ,18x,17hsubset level test) ! 404: c ! 405: c format statements for run summaries ! 406: 90008 format (1h ,15x,i5,19h errors encountered) ! 407: 90009 format (1h ,15x,i5,13h tests passed) ! 408: 90010 format (1h ,15x,i5,14h tests deleted) ! 409: c ! 410: c format statements for test results ! 411: 80001 format (1h ,4x,i5,7x,4hpass) ! 412: 80002 format (1h ,4x,i5,7x,4hfail) ! 413: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 414: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 415: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 416: c ! 417: 90007 format (1h ,20x,20hend of program fm056) ! 418: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.