![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm020.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 fm020.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 fm020 ! 5: c ! 6: c this routine tests the fortran in-line statement function ! 7: c of type logical and integer. integer constants, logical constants ! 8: c integer variables, logical variables, integer arithmetic express- ! 9: c ions are all used to test the statement function definition and ! 10: c the value returned for the statement function when it is used ! 11: c in the main body of the program. ! 12: c ! 13: c references ! 14: c american national standard programming language fortran, ! 15: c x3.9-1978 ! 16: c ! 17: c section 8.4.1, integer, real, double precision, complex, and ! 18: c logical type-statements ! 19: c section 15.3.2, intrinsic function references ! 20: c section 15.4, statement functions ! 21: c section 15.4.1, forms of a function statement ! 22: c section 15.4.2, referencing a statement function ! 23: c section 15.5.2, external function references ! 24: c ! 25: logical lftn01, ldtn01 ! 26: logical lftn02, ldtn02 ! 27: logical lftn03, ldtn03, lctn03 ! 28: logical lftn04, ldtn04, lctn04 ! 29: dimension iadn11(2) ! 30: c ! 31: c..... test 553 ! 32: ifon01(idon01) = 32767 ! 33: c ! 34: c..... test 554 ! 35: lftn01(ldtn01) = .true. ! 36: c ! 37: c..... test 555 ! 38: ifon02 ( idon02 ) = idon02 ! 39: c ! 40: c..... test 556 ! 41: lftn02( ldtn02 ) = ldtn02 ! 42: c ! 43: c..... test 557 ! 44: ifon03 (idon03 )= idon03 ! 45: c ! 46: c..... test 558 ! 47: lftn03(ldtn03) = ldtn03 ! 48: c ! 49: c..... test 559 ! 50: lftn04(ldtn04) = .not. ldtn04 ! 51: c ! 52: c..... test 560 ! 53: ifon04(idon04) = idon04 ** 2 ! 54: c ! 55: c..... test 561 ! 56: ifon05(idon05, idon06) = idon05 + idon06 ! 57: c ! 58: c..... test 562 ! 59: ifon06(idon07, idon08) = sqrt(float(idon07**2)+float(idon08**2)) ! 60: c ! 61: c..... test 563 ! 62: ifon07(idon09) = idon09 ** 2 ! 63: ifon08(i,j)=sqrt(float(ifon07(i))+float(ifon07(j))) ! 64: c ! 65: c..... test 564 ! 66: ifon09(k,l) = k / l + k ** l - k * l ! 67: c ! 68: c ! 69: c ! 70: c ********************************************************** ! 71: c ! 72: c a compiler validation system for the fortran language ! 73: c based on specifications as defined in american national standard ! 74: c programming language fortran x3.9-1978, has been developed by the ! 75: c federal cobol compiler testing service. the fortran compiler ! 76: c validation system (fcvs) consists of audit routines, their related ! 77: c data, and an executive system. each audit routine is a fortran ! 78: c program, subprogram or function which includes tests of specific ! 79: c language elements and supporting procedures indicating the result ! 80: c of executing these tests. ! 81: c ! 82: c this particular program/subprogram/function contains features ! 83: c found only in the subset as defined in x3.9-1978. ! 84: c ! 85: c suggestions and comments should be forwarded to - ! 86: c ! 87: c department of the navy ! 88: c federal cobol compiler testing service ! 89: c washington, d.c. 20376 ! 90: c ! 91: c ********************************************************** ! 92: c ! 93: c ! 94: c ! 95: c initialization section ! 96: c ! 97: c initialize constants ! 98: c ************** ! 99: c i01 contains the logical unit number for the card reader. ! 100: i01 = 5 ! 101: c i02 contains the logical unit number for the printer. ! 102: i02 = 6 ! 103: c system environment section ! 104: c ! 105: cx010 this card is replaced by contents of fexec x-010 control card. ! 106: c the cx010 card is for overriding the program default i01 = 5 ! 107: c (unit number for card reader). ! 108: cx011 this card is replaced by contents of fexec x-011 control card. ! 109: c the cx011 card is for systems which require additional ! 110: c fortran statements for files associated with cx010 above. ! 111: c ! 112: cx020 this card is replaced by contents of fexec x-020 control card. ! 113: c the cx020 card is for overriding the program default i02 = 6 ! 114: c (unit number for printer). ! 115: cx021 this card is replaced by contents of fexec x-021 control card. ! 116: c the cx021 card is for systems which require additional ! 117: c fortran statements for files associated with cx020 above. ! 118: c ! 119: ivpass=0 ! 120: ivfail=0 ! 121: ivdele=0 ! 122: iczero=0 ! 123: c ! 124: c write page headers ! 125: write (i02,90000) ! 126: write (i02,90001) ! 127: write (i02,90002) ! 128: write (i02, 90002) ! 129: write (i02,90003) ! 130: write (i02,90002) ! 131: write (i02,90004) ! 132: write (i02,90002) ! 133: write (i02,90011) ! 134: write (i02,90002) ! 135: write (i02,90002) ! 136: write (i02,90005) ! 137: write (i02,90006) ! 138: write (i02,90002) ! 139: ivtnum = 553 ! 140: c ! 141: c **** test 553 **** ! 142: c test 553 - the value of the integer function is set to a ! 143: c constant of 32767 regardless of the value of the arguement ! 144: c supplied to the dummy arguement. test of positive integer ! 145: c constants for a statement function. ! 146: c ! 147: c ! 148: if (iczero) 35530, 5530, 35530 ! 149: 5530 continue ! 150: ivcomp = ifon01(3) ! 151: go to 45530 ! 152: 35530 ivdele = ivdele + 1 ! 153: write (i02,80003) ivtnum ! 154: if (iczero) 45530, 5541, 45530 ! 155: 45530 if ( ivcomp - 32767 ) 25530, 15530, 25530 ! 156: 15530 ivpass = ivpass + 1 ! 157: write (i02,80001) ivtnum ! 158: go to 5541 ! 159: 25530 ivfail = ivfail + 1 ! 160: ivcorr = 32767 ! 161: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 162: 5541 continue ! 163: ivtnum = 554 ! 164: c ! 165: c **** test 554 **** ! 166: c test 554 - test of the statement function of type logical ! 167: c set to the logical constant .true. regardless of the ! 168: c arguement supplied to the dummy arguement. ! 169: c a logical if statement is used in conjunction with the logical ! 170: c statement function. the true path is tested. ! 171: c ! 172: c ! 173: if (iczero) 35540, 5540, 35540 ! 174: 5540 continue ! 175: ivon01 = 0 ! 176: if ( lftn01(.false.) ) ivon01 = 1 ! 177: go to 45540 ! 178: 35540 ivdele = ivdele + 1 ! 179: write (i02,80003) ivtnum ! 180: if (iczero) 45540, 5551, 45540 ! 181: 45540 if ( ivon01 - 1 ) 25540, 15540, 25540 ! 182: 15540 ivpass = ivpass + 1 ! 183: write (i02,80001) ivtnum ! 184: go to 5551 ! 185: 25540 ivfail = ivfail + 1 ! 186: ivcomp = ivon01 ! 187: ivcorr = 1 ! 188: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 189: 5551 continue ! 190: ivtnum = 555 ! 191: c ! 192: c **** test 555 **** ! 193: c test 555 - the integer statement function is set to the value ! 194: c of the argeument supplied. ! 195: c ! 196: c ! 197: if (iczero) 35550, 5550, 35550 ! 198: 5550 continue ! 199: ivcomp = ifon02 ( 32767 ) ! 200: go to 45550 ! 201: 35550 ivdele = ivdele + 1 ! 202: write (i02,80003) ivtnum ! 203: if (iczero) 45550, 5561, 45550 ! 204: 45550 if ( ivcomp - 32767 ) 25550, 15550, 25550 ! 205: 15550 ivpass = ivpass + 1 ! 206: write (i02,80001) ivtnum ! 207: go to 5561 ! 208: 25550 ivfail = ivfail + 1 ! 209: ivcorr = 32767 ! 210: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 211: 5561 continue ! 212: ivtnum = 556 ! 213: c ! 214: c **** test 556 **** ! 215: c test 556 - test of a logical statement function set to the ! 216: c value of the arguement supplied. the false path of a logical ! 217: c if statement is used in conjunction with the logical ! 218: c statement function. ! 219: c ! 220: c ! 221: if (iczero) 35560, 5560, 35560 ! 222: 5560 continue ! 223: ivon01 = 1 ! 224: if ( lftn02(.false.) ) ivon01 = 0 ! 225: go to 45560 ! 226: 35560 ivdele = ivdele + 1 ! 227: write (i02,80003) ivtnum ! 228: if (iczero) 45560, 5571, 45560 ! 229: 45560 if ( ivon01 - 1 ) 25560, 15560, 25560 ! 230: 15560 ivpass = ivpass + 1 ! 231: write (i02,80001) ivtnum ! 232: go to 5571 ! 233: 25560 ivfail = ivfail + 1 ! 234: ivcomp = ivon01 ! 235: ivcorr = 1 ! 236: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 237: 5571 continue ! 238: ivtnum = 557 ! 239: c ! 240: c **** test 557 **** ! 241: c test 557 - the value of an integer function is set equal to ! 242: c value of the arguement supplied. this value is an integer ! 243: c variable set to 32767. ! 244: c ! 245: c ! 246: if (iczero) 35570, 5570, 35570 ! 247: 5570 continue ! 248: icon01 = 32767 ! 249: ivcomp = ifon03 ( icon01 ) ! 250: go to 45570 ! 251: 35570 ivdele = ivdele + 1 ! 252: write (i02,80003) ivtnum ! 253: if (iczero) 45570, 5581, 45570 ! 254: 45570 if ( ivcomp - 32767 ) 25570, 15570, 25570 ! 255: 15570 ivpass = ivpass + 1 ! 256: write (i02,80001) ivtnum ! 257: go to 5581 ! 258: 25570 ivfail = ivfail + 1 ! 259: ivcorr = 32767 ! 260: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 261: 5581 continue ! 262: ivtnum = 558 ! 263: c ! 264: c **** test 558 **** ! 265: c test 558 - a logical statement function is set equal to the ! 266: c value of the arguement supplied. this value is a logical ! 267: c variable set to .true. the true path of a logical if ! 268: c statement is used in conjunction with the logical statement ! 269: c function. ! 270: c ! 271: c ! 272: if (iczero) 35580, 5580, 35580 ! 273: 5580 continue ! 274: ivon01 = 0 ! 275: lctn03 = .true. ! 276: if ( lftn03(lctn03) ) ivon01 = 1 ! 277: go to 45580 ! 278: 35580 ivdele = ivdele + 1 ! 279: write (i02,80003) ivtnum ! 280: if (iczero) 45580, 5591, 45580 ! 281: 45580 if ( ivon01 - 1 ) 25580, 15580, 25580 ! 282: 15580 ivpass = ivpass + 1 ! 283: write (i02,80001) ivtnum ! 284: go to 5591 ! 285: 25580 ivfail = ivfail + 1 ! 286: ivcomp = ivon01 ! 287: ivcorr = 1 ! 288: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 289: 5591 continue ! 290: ivtnum = 559 ! 291: c ! 292: c **** test 559 **** ! 293: c test 559 - like test 558 only the logical .not. is used ! 294: c in the logical statement function definition the false path ! 295: c of a logical if statement is used in conjunction with the ! 296: c logical statement function. ! 297: c ! 298: c ! 299: if (iczero) 35590, 5590, 35590 ! 300: 5590 continue ! 301: ivon01 = 1 ! 302: lctn04 = .true. ! 303: if ( lftn04(lctn04) ) ivon01 = 0 ! 304: go to 45590 ! 305: 35590 ivdele = ivdele + 1 ! 306: write (i02,80003) ivtnum ! 307: if (iczero) 45590, 5601, 45590 ! 308: 45590 if ( ivon01 - 1 ) 25590, 15590, 25590 ! 309: 15590 ivpass = ivpass + 1 ! 310: write (i02,80001) ivtnum ! 311: go to 5601 ! 312: 25590 ivfail = ivfail + 1 ! 313: ivcomp = ivon01 ! 314: ivcorr = 1 ! 315: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 316: 5601 continue ! 317: ivtnum = 560 ! 318: c ! 319: c **** test 560 **** ! 320: c test 560 - integer exponientiation used in an integer ! 321: c statement function. ! 322: c ! 323: c ! 324: if (iczero) 35600, 5600, 35600 ! 325: 5600 continue ! 326: icon04 = 3 ! 327: ivcomp = ifon04(icon04) ! 328: go to 45600 ! 329: 35600 ivdele = ivdele + 1 ! 330: write (i02,80003) ivtnum ! 331: if (iczero) 45600, 5611, 45600 ! 332: 45600 if ( ivcomp - 9 ) 25600, 15600, 25600 ! 333: 15600 ivpass = ivpass + 1 ! 334: write (i02,80001) ivtnum ! 335: go to 5611 ! 336: 25600 ivfail = ivfail + 1 ! 337: ivcorr = 9 ! 338: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 339: 5611 continue ! 340: ivtnum = 561 ! 341: c ! 342: c **** test 561 **** ! 343: c test 561 - test of integer addition using two (2) dummy ! 344: c arguements. ! 345: c ! 346: c ! 347: if (iczero) 35610, 5610, 35610 ! 348: 5610 continue ! 349: icon05 = 9 ! 350: icon06 = 16 ! 351: ivcomp = ifon05(icon05, icon06) ! 352: go to 45610 ! 353: 35610 ivdele = ivdele + 1 ! 354: write (i02,80003) ivtnum ! 355: if (iczero) 45610, 5621, 45610 ! 356: 45610 if ( ivcomp - 25 ) 25610, 15610, 25610 ! 357: 15610 ivpass = ivpass + 1 ! 358: write (i02,80001) ivtnum ! 359: go to 5621 ! 360: 25610 ivfail = ivfail + 1 ! 361: ivcorr = 25 ! 362: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 363: 5621 continue ! 364: ivtnum = 562 ! 365: c ! 366: c **** test 562 **** ! 367: c test 562 - this test is the solution of a right triangle ! 368: c using integer statement functions which reference the ! 369: c intrinsic functions sqrt and float. this is a 3-4-5 ! 370: c right triangle. ! 371: c ! 372: c ! 373: if (iczero) 35620, 5620, 35620 ! 374: 5620 continue ! 375: icon07 = 3 ! 376: icon08 = 4 ! 377: ivcomp = ifon06(icon07, icon08) ! 378: go to 45620 ! 379: 35620 ivdele = ivdele + 1 ! 380: write (i02,80003) ivtnum ! 381: if (iczero) 45620, 5631, 45620 ! 382: 45620 if ( ivcomp - 5 ) 5622, 15620, 5622 ! 383: 5622 if ( ivcomp - 4 ) 25620, 15620, 25620 ! 384: 15620 ivpass = ivpass + 1 ! 385: write (i02,80001) ivtnum ! 386: go to 5631 ! 387: 25620 ivfail = ivfail + 1 ! 388: ivcorr = 5 ! 389: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 390: 5631 continue ! 391: ivtnum = 563 ! 392: c ! 393: c **** test 563 **** ! 394: c test 563 - solution of a 3-4-5 right triangle like test 562 ! 395: c except that both intrinsic and previously defined statement ! 396: c functions are used. ! 397: c ! 398: c ! 399: if (iczero) 35630, 5630, 35630 ! 400: 5630 continue ! 401: icon09 = 3 ! 402: icon10 = 4 ! 403: ivcomp = ifon08(icon09, icon10) ! 404: go to 45630 ! 405: 35630 ivdele = ivdele + 1 ! 406: write (i02,80003) ivtnum ! 407: if (iczero) 45630, 5641, 45630 ! 408: 45630 if ( ivcomp - 5 ) 5632, 15630, 5632 ! 409: 5632 if ( ivcomp - 4 ) 25630, 15630, 25630 ! 410: 15630 ivpass = ivpass + 1 ! 411: write (i02,80001) ivtnum ! 412: go to 5641 ! 413: 25630 ivfail = ivfail + 1 ! 414: ivcorr = 5 ! 415: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 416: 5641 continue ! 417: ivtnum = 564 ! 418: c ! 419: c **** test 564 **** ! 420: c test 564 - use of array elements in an integer statement ! 421: c function which uses the operations of + - * / . ! 422: c ! 423: c ! 424: if (iczero) 35640, 5640, 35640 ! 425: 5640 continue ! 426: iadn11(1) = 2 ! 427: iadn11(2) = 2 ! 428: ivcomp = ifon09( iadn11(1), iadn11(2) ) ! 429: go to 45640 ! 430: 35640 ivdele = ivdele + 1 ! 431: write (i02,80003) ivtnum ! 432: if (iczero) 45640, 5651, 45640 ! 433: 45640 if ( ivcomp - 1 ) 25640, 15640, 25640 ! 434: 15640 ivpass = ivpass + 1 ! 435: write (i02,80001) ivtnum ! 436: go to 5651 ! 437: 25640 ivfail = ivfail + 1 ! 438: ivcorr = 1 ! 439: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 440: 5651 continue ! 441: c ! 442: c write page footings and run summaries ! 443: 99999 continue ! 444: write (i02,90002) ! 445: write (i02,90006) ! 446: write (i02,90002) ! 447: write (i02,90002) ! 448: write (i02,90007) ! 449: write (i02,90002) ! 450: write (i02,90008) ivfail ! 451: write (i02,90009) ivpass ! 452: write (i02,90010) ivdele ! 453: c ! 454: c ! 455: c terminate routine execution ! 456: stop ! 457: c ! 458: c format statements for page headers ! 459: 90000 format (1h1) ! 460: 90002 format (1h ) ! 461: 90001 format (1h ,10x,34hfortran compiler validation system) ! 462: 90003 format (1h ,21x,11hversion 1.0) ! 463: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 464: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 465: 90006 format (1h ,5x,46h----------------------------------------------) ! 466: 90011 format (1h ,18x,17hsubset level test) ! 467: c ! 468: c format statements for run summaries ! 469: 90008 format (1h ,15x,i5,19h errors encountered) ! 470: 90009 format (1h ,15x,i5,13h tests passed) ! 471: 90010 format (1h ,15x,i5,14h tests deleted) ! 472: c ! 473: c format statements for test results ! 474: 80001 format (1h ,4x,i5,7x,4hpass) ! 475: 80002 format (1h ,4x,i5,7x,4hfail) ! 476: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 477: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 478: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 479: c ! 480: 90007 format (1h ,20x,20hend of program fm020) ! 481: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.