![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm026.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 fm026.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: c comment section ! 2: c ! 3: c fm026 ! 4: c ! 5: c this routine contains the basic subroutine reference tests. ! 6: c the subroutine fs027 is called by this program. the subroutine ! 7: c fs027 increments the calling argument by 1 and returns to the ! 8: c calling program. ! 9: c ! 10: c execution of a subroutine reference results in an association ! 11: c of actual arguments with all appearances of dummy arguments in ! 12: c the defining subprogram. following these associations, execution ! 13: c of the first executable statement of the defining subprogram ! 14: c is undertaken. ! 15: c ! 16: c references ! 17: c american national standard programming language fortran, ! 18: c x3.9-1978 ! 19: c ! 20: c section 15.6.2, subroutine reference ! 21: c ! 22: c ********************************************************** ! 23: c ! 24: c a compiler validation system for the fortran language ! 25: c based on specifications as defined in american national standard ! 26: c programming language fortran x3.9-1978, has been developed by the ! 27: c federal cobol compiler testing service. the fortran compiler ! 28: c validation system (fcvs) consists of audit routines, their related ! 29: c data, and an executive system. each audit routine is a fortran ! 30: c program, subprogram or function which includes tests of specific ! 31: c language elements and supporting procedures indicating the result ! 32: c of executing these tests. ! 33: c ! 34: c this particular program/subprogram/function contains features ! 35: c found only in the subset as defined in x3.9-1978. ! 36: c ! 37: c suggestions and comments should be forwarded to - ! 38: c ! 39: c department of the navy ! 40: c federal cobol compiler testing service ! 41: c washington, d.c. 20376 ! 42: c ! 43: c ********************************************************** ! 44: c ! 45: c ! 46: c ! 47: c initialization section ! 48: c ! 49: c initialize constants ! 50: c ************** ! 51: c i01 contains the logical unit number for the card reader. ! 52: i01 = 5 ! 53: c i02 contains the logical unit number for the printer. ! 54: i02 = 6 ! 55: c system environment section ! 56: c ! 57: cx010 this card is replaced by contents of fexec x-010 control card. ! 58: c the cx010 card is for overriding the program default i01 = 5 ! 59: c (unit number for card reader). ! 60: cx011 this card is replaced by contents of fexec x-011 control card. ! 61: c the cx011 card is for systems which require additional ! 62: c fortran statements for files associated with cx010 above. ! 63: c ! 64: cx020 this card is replaced by contents of fexec x-020 control card. ! 65: c the cx020 card is for overriding the program default i02 = 6 ! 66: c (unit number for printer). ! 67: cx021 this card is replaced by contents of fexec x-021 control card. ! 68: c the cx021 card is for systems which require additional ! 69: c fortran statements for files associated with cx020 above. ! 70: c ! 71: ivpass=0 ! 72: ivfail=0 ! 73: ivdele=0 ! 74: iczero=0 ! 75: c ! 76: c write page headers ! 77: write (i02,90000) ! 78: write (i02,90001) ! 79: write (i02,90002) ! 80: write (i02, 90002) ! 81: write (i02,90003) ! 82: write (i02,90002) ! 83: write (i02,90004) ! 84: write (i02,90002) ! 85: write (i02,90011) ! 86: write (i02,90002) ! 87: write (i02,90002) ! 88: write (i02,90005) ! 89: write (i02,90006) ! 90: write (i02,90002) ! 91: c ! 92: c test section ! 93: c ! 94: c subroutine reference - call ! 95: c ! 96: ivtnum = 666 ! 97: c ! 98: c **** test 666 **** ! 99: c subroutine call - argument name same as subroutine argument name. ! 100: c ! 101: if (iczero) 36660, 6660, 36660 ! 102: 6660 continue ! 103: ivon01 = 0 ! 104: call fs027(ivon01) ! 105: ivcomp = ivon01 ! 106: go to 46660 ! 107: 36660 ivdele = ivdele + 1 ! 108: write (i02,80003) ivtnum ! 109: if (iczero) 46660, 6671, 46660 ! 110: 46660 if (ivcomp - 1) 26660,16660,26660 ! 111: 16660 ivpass = ivpass + 1 ! 112: write (i02,80001) ivtnum ! 113: go to 6671 ! 114: 26660 ivfail = ivfail + 1 ! 115: ivcorr = 1 ! 116: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 117: 6671 continue ! 118: ivtnum = 667 ! 119: c ! 120: c **** test 667 **** ! 121: c subroutine call - argument name same as internal variable in ! 122: c subroutine. ! 123: c ! 124: if (iczero) 36670, 6670, 36670 ! 125: 6670 continue ! 126: ivon02 = 2 ! 127: call fs027(ivon02) ! 128: ivcomp = ivon02 ! 129: go to 46670 ! 130: 36670 ivdele = ivdele + 1 ! 131: write (i02,80003) ivtnum ! 132: if (iczero) 46670, 6681, 46670 ! 133: 46670 if (ivcomp - 3) 26670,16670,26670 ! 134: 16670 ivpass = ivpass + 1 ! 135: write (i02,80001) ivtnum ! 136: go to 6681 ! 137: 26670 ivfail = ivfail + 1 ! 138: ivcorr = 3 ! 139: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 140: 6681 continue ! 141: ivtnum = 668 ! 142: c ! 143: c **** test 668 **** ! 144: c subroutine call - argument name different from subroutine argument ! 145: c and internal variable. ! 146: c ! 147: if (iczero) 36680, 6680, 36680 ! 148: 6680 continue ! 149: ivon01 = 7 ! 150: ivon03 = -12 ! 151: call fs027(ivon03) ! 152: ivcomp = ivon03 ! 153: go to 46680 ! 154: 36680 ivdele = ivdele + 1 ! 155: write (i02,80003) ivtnum ! 156: if (iczero) 46680, 6691, 46680 ! 157: 46680 if (ivcomp + 11 ) 26680,16680,26680 ! 158: 16680 ivpass = ivpass + 1 ! 159: write (i02,80001) ivtnum ! 160: go to 6691 ! 161: 26680 ivfail = ivfail + 1 ! 162: ivcorr = -11 ! 163: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 164: 6691 continue ! 165: ivtnum = 669 ! 166: c ! 167: c **** test 669 **** ! 168: c repeated subroutine calls in a do loop. ! 169: c ! 170: if (iczero) 36690, 6690, 36690 ! 171: 6690 continue ! 172: ivcomp = 0 ! 173: do 6692 ivon04 = 1,5 ! 174: call fs027 (ivcomp) ! 175: 6692 continue ! 176: go to 46690 ! 177: 36690 ivdele = ivdele + 1 ! 178: write (i02,80003) ivtnum ! 179: if (iczero) 46690, 6701, 46690 ! 180: 46690 if (ivcomp - 5) 26690,16690,26690 ! 181: 16690 ivpass = ivpass + 1 ! 182: write (i02,80001) ivtnum ! 183: go to 6701 ! 184: 26690 ivfail = ivfail + 1 ! 185: ivcorr = 5 ! 186: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 187: c **** end of tests **** ! 188: 6701 continue ! 189: c ! 190: c write page footings and run summaries ! 191: 99999 continue ! 192: write (i02,90002) ! 193: write (i02,90006) ! 194: write (i02,90002) ! 195: write (i02,90002) ! 196: write (i02,90007) ! 197: write (i02,90002) ! 198: write (i02,90008) ivfail ! 199: write (i02,90009) ivpass ! 200: write (i02,90010) ivdele ! 201: c ! 202: c ! 203: c terminate routine execution ! 204: stop ! 205: c ! 206: c format statements for page headers ! 207: 90000 format (1h1) ! 208: 90002 format (1h ) ! 209: 90001 format (1h ,10x,34hfortran compiler validation system) ! 210: 90003 format (1h ,21x,11hversion 1.0) ! 211: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 212: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 213: 90006 format (1h ,5x,46h----------------------------------------------) ! 214: 90011 format (1h ,18x,17hsubset level test) ! 215: c ! 216: c format statements for run summaries ! 217: 90008 format (1h ,15x,i5,19h errors encountered) ! 218: 90009 format (1h ,15x,i5,13h tests passed) ! 219: 90010 format (1h ,15x,i5,14h tests deleted) ! 220: c ! 221: c format statements for test results ! 222: 80001 format (1h ,4x,i5,7x,4hpass) ! 223: 80002 format (1h ,4x,i5,7x,4hfail) ! 224: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 225: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 226: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 227: c ! 228: 90007 format (1h ,20x,20hend of program fm026) ! 229: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.