![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM028.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM028.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C COMMENT SECTION 00010028 ! 2: C DATE***82/08/02*18.33.46 ! 3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 4: C AUDIT FCVS78 V2.0 ! 5: C 00020028 ! 6: C FM028 00030028 ! 7: C 00040028 ! 8: C THIS ROUTINE CONTAINS THE EXTERNAL FUNCTION REFERENCE TESTS. 00050028 ! 9: C THE FUNCTION SUBPROGRAM FF029 IS CALLED BY THIS PROGRAM. THE 00060028 ! 10: C FUNCTION SUBPROGRAM FF029 INCREMENTS THE CALLING ARGUMENT BY 1 00070028 ! 11: C AND RETURNS TO THE CALLING PROGRAM. 00080028 ! 12: C 00090028 ! 13: C EXECUTION OF AN EXTERNAL FUNCTION REFERENCE RESULTS IN AN 00100028 ! 14: C ASSOCIATION OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY 00110028 ! 15: C ARGUMENTS IN THE DEFINING SUBPROGRAM. FOLLOWING THESE 00120028 ! 16: C ASSOCIATIONS, EXECUTION OF THE FIRST EXECUTABLE STATEMENT OF THE 00130028 ! 17: C DEFINING SUBPROGRAM IS UNDERTAKEN. 00140028 ! 18: C 00150028 ! 19: C REFERENCES 00160028 ! 20: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00170028 ! 21: C X3.9-1978 00180028 ! 22: C 00190028 ! 23: C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION 00200028 ! 24: C 00210028 ! 25: INTEGER FF029 00220028 ! 26: C 00230028 ! 27: C 00240028 ! 28: C ********************************************************** 00250028 ! 29: C 00260028 ! 30: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00270028 ! 31: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00280028 ! 32: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00290028 ! 33: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00300028 ! 34: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00310028 ! 35: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00320028 ! 36: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00330028 ! 37: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00340028 ! 38: C OF EXECUTING THESE TESTS. 00350028 ! 39: C 00360028 ! 40: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00370028 ! 41: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00380028 ! 42: C 00390028 ! 43: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00400028 ! 44: C 00410028 ! 45: C DEPARTMENT OF THE NAVY 00420028 ! 46: C FEDERAL COBOL COMPILER TESTING SERVICE 00430028 ! 47: C WASHINGTON, D.C. 20376 00440028 ! 48: C 00450028 ! 49: C ********************************************************** 00460028 ! 50: C 00470028 ! 51: C 00480028 ! 52: C 00490028 ! 53: C INITIALIZATION SECTION 00500028 ! 54: C 00510028 ! 55: C INITIALIZE CONSTANTS 00520028 ! 56: C ************** 00530028 ! 57: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00540028 ! 58: I01 = 5 00550028 ! 59: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00560028 ! 60: I02 = 6 00570028 ! 61: C SYSTEM ENVIRONMENT SECTION 00580028 ! 62: C 00590028 ! 63: I01 = 5 00600028 ! 64: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00610028 ! 65: C (UNIT NUMBER FOR CARD READER). 00620028 ! 66: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00630028 ! 67: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00640028 ! 68: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00650028 ! 69: C 00660028 ! 70: I02 = 6 00670028 ! 71: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00680028 ! 72: C (UNIT NUMBER FOR PRINTER). 00690028 ! 73: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00700028 ! 74: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00710028 ! 75: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00720028 ! 76: C 00730028 ! 77: IVPASS=0 00740028 ! 78: IVFAIL=0 00750028 ! 79: IVDELE=0 00760028 ! 80: ICZERO=0 00770028 ! 81: C 00780028 ! 82: C WRITE PAGE HEADERS 00790028 ! 83: WRITE (I02,90000) 00800028 ! 84: WRITE (I02,90001) 00810028 ! 85: WRITE (I02,90002) 00820028 ! 86: WRITE (I02, 90002) 00830028 ! 87: WRITE (I02,90003) 00840028 ! 88: WRITE (I02,90002) 00850028 ! 89: WRITE (I02,90004) 00860028 ! 90: WRITE (I02,90002) 00870028 ! 91: WRITE (I02,90011) 00880028 ! 92: WRITE (I02,90002) 00890028 ! 93: WRITE (I02,90002) 00900028 ! 94: WRITE (I02,90005) 00910028 ! 95: WRITE (I02,90006) 00920028 ! 96: WRITE (I02,90002) 00930028 ! 97: C 00940028 ! 98: C TEST SECTION 00950028 ! 99: C 00960028 ! 100: C EXTERNAL FUNCTION REFERENCE 00970028 ! 101: C 00980028 ! 102: C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS SUBPROGRAM 00990028 ! 103: C ARGUMENT NAME. 01000028 ! 104: 6701 CONTINUE 01010028 ! 105: IVTNUM = 670 01020028 ! 106: C 01030028 ! 107: C **** TEST 670 **** 01040028 ! 108: C 01050028 ! 109: IF (ICZERO) 36700,6700,36700 01060028 ! 110: 6700 CONTINUE 01070028 ! 111: IVON01 = 0 01080028 ! 112: IVCOMP = FF029(IVON01) 01090028 ! 113: GO TO 46700 01100028 ! 114: 36700 IVDELE = IVDELE + 1 01110028 ! 115: WRITE (I02,80003) IVTNUM 01120028 ! 116: IF (ICZERO) 46700,6711,46700 01130028 ! 117: 46700 IF (IVCOMP - 1) 26700,16700,26700 01140028 ! 118: 16700 IVPASS = IVPASS + 1 01150028 ! 119: WRITE (I02,80001) IVTNUM 01160028 ! 120: GO TO 6711 01170028 ! 121: 26700 IVFAIL = IVFAIL + 1 01180028 ! 122: IVCORR = 1 01190028 ! 123: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01200028 ! 124: 6711 CONTINUE 01210028 ! 125: IVTNUM = 671 01220028 ! 126: C 01230028 ! 127: C **** TEST 671 **** 01240028 ! 128: C 01250028 ! 129: C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS INTERNAL 01260028 ! 130: C VARIABLE IN FUNCTION SUBPROGRAM. 01270028 ! 131: C 01280028 ! 132: IF (ICZERO) 36710,6710,36710 01290028 ! 133: 6710 CONTINUE 01300028 ! 134: IVON02 = 2 01310028 ! 135: IVON01 = 5 01320028 ! 136: IVCOMP = FF029(IVON02) 01330028 ! 137: GO TO 46710 01340028 ! 138: 36710 IVDELE = IVDELE + 1 01350028 ! 139: WRITE (I02,80003) IVTNUM 01360028 ! 140: IF (ICZERO) 46710,6721,46710 01370028 ! 141: 46710 IF (IVCOMP - 3) 26710,16710,26710 01380028 ! 142: 16710 IVPASS = IVPASS + 1 01390028 ! 143: WRITE (I02,80001) IVTNUM 01400028 ! 144: GO TO 6721 01410028 ! 145: 26710 IVFAIL = IVFAIL + 1 01420028 ! 146: IVCORR = 3 01430028 ! 147: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01440028 ! 148: 6721 CONTINUE 01450028 ! 149: IVTNUM = 672 01460028 ! 150: C 01470028 ! 151: C **** TEST 672 **** 01480028 ! 152: C 01490028 ! 153: C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME DIFFERENT FROM 01500028 ! 154: C FUNCTION SUBPROGRAM ARGUMENT AND INTERNAL VARIABLE. 01510028 ! 155: C 01520028 ! 156: IF (ICZERO) 36720,6720,36720 01530028 ! 157: 6720 CONTINUE 01540028 ! 158: IVON01 = 7 01550028 ! 159: IVON03 = -12 01560028 ! 160: IVCOMP = FF029(IVON03) 01570028 ! 161: GO TO 46720 01580028 ! 162: 36720 IVDELE = IVDELE + 1 01590028 ! 163: WRITE (I02,80003) IVTNUM 01600028 ! 164: IF (ICZERO) 46720,6731,46720 01610028 ! 165: 46720 IF (IVCOMP + 11) 26720,16720,26720 01620028 ! 166: 16720 IVPASS = IVPASS + 1 01630028 ! 167: WRITE (I02,80001) IVTNUM 01640028 ! 168: GO TO 6731 01650028 ! 169: 26720 IVFAIL = IVFAIL + 1 01660028 ! 170: IVCORR = -11 01670028 ! 171: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01680028 ! 172: 6731 CONTINUE 01690028 ! 173: IVTNUM = 673 01700028 ! 174: C 01710028 ! 175: C **** TEST 673 **** 01720028 ! 176: C 01730028 ! 177: C REPEATED EXTERNAL FUNCTION REFERENCE IN A DO LOOP. 01740028 ! 178: C 01750028 ! 179: IF (ICZERO) 36730,6730,36730 01760028 ! 180: 6730 CONTINUE 01770028 ! 181: IVON01 = -7 01780028 ! 182: IVCOMP = 0 01790028 ! 183: DO 6732 IVON04 = 1,5 01800028 ! 184: IVCOMP = FF029(IVCOMP) 01810028 ! 185: 6732 CONTINUE 01820028 ! 186: GO TO 46730 01830028 ! 187: 36730 IVDELE = IVDELE + 1 01840028 ! 188: WRITE (I02,80003) IVTNUM 01850028 ! 189: IF (ICZERO) 46730,6741,46730 01860028 ! 190: 46730 IF (IVCOMP - 5) 26730,16730,26730 01870028 ! 191: 16730 IVPASS = IVPASS + 1 01880028 ! 192: WRITE (I02,80001) IVTNUM 01890028 ! 193: GO TO 6741 01900028 ! 194: 26730 IVFAIL = IVFAIL + 1 01910028 ! 195: IVCORR = 5 01920028 ! 196: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01930028 ! 197: 6741 CONTINUE 01940028 ! 198: C 01950028 ! 199: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 01960028 ! 200: 99999 CONTINUE 01970028 ! 201: WRITE (I02,90002) 01980028 ! 202: WRITE (I02,90006) 01990028 ! 203: WRITE (I02,90002) 02000028 ! 204: WRITE (I02,90002) 02010028 ! 205: WRITE (I02,90007) 02020028 ! 206: WRITE (I02,90002) 02030028 ! 207: WRITE (I02,90008) IVFAIL 02040028 ! 208: WRITE (I02,90009) IVPASS 02050028 ! 209: WRITE (I02,90010) IVDELE 02060028 ! 210: C 02070028 ! 211: C 02080028 ! 212: C TERMINATE ROUTINE EXECUTION 02090028 ! 213: STOP 02100028 ! 214: C 02110028 ! 215: C FORMAT STATEMENTS FOR PAGE HEADERS 02120028 ! 216: 90000 FORMAT (1H1) 02130028 ! 217: 90002 FORMAT (1H ) 02140028 ! 218: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02150028 ! 219: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02160028 ! 220: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02170028 ! 221: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02180028 ! 222: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02190028 ! 223: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02200028 ! 224: C 02210028 ! 225: C FORMAT STATEMENTS FOR RUN SUMMARIES 02220028 ! 226: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02230028 ! 227: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02240028 ! 228: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02250028 ! 229: C 02260028 ! 230: C FORMAT STATEMENTS FOR TEST RESULTS 02270028 ! 231: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02280028 ! 232: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02290028 ! 233: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02300028 ! 234: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02310028 ! 235: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02320028 ! 236: C 02330028 ! 237: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM028) 02340028 ! 238: END 02350028 ! 239: INTEGER FUNCTION FF029(IVON01) 00010029 ! 240: C DATE***82/08/02*18.33.46 ! 241: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 242: C AUDIT FCVS78 V2.0 ! 243: C 00020029 ! 244: C COMMENT SECTION 00030029 ! 245: C FF029 00040029 ! 246: C 00050029 ! 247: C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM028. 00060029 ! 248: C THE FUNCTION ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED 00070029 ! 249: C TO THE CALLING PROGRAM. 00080029 ! 250: C 00090029 ! 251: C REFERENCES 00100029 ! 252: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110029 ! 253: C X3.9-1978 00120029 ! 254: C 00130029 ! 255: C SECTION 15.5.1, DEFINING FUNCTION SUBPROGRAMS AND FUNCTION 00140029 ! 256: C STATEMENTS 00150029 ! 257: C SECTION 15.8, RETURN STATEMENT 00160029 ! 258: C 00170029 ! 259: C TEST SECTION 00180029 ! 260: C 00190029 ! 261: C FUNCTION SUBPROGRAM 00200029 ! 262: C 00210029 ! 263: C INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM. 00220029 ! 264: C 00230029 ! 265: IVON02 = IVON01 00240029 ! 266: FF029 = IVON02 + 1 00250029 ! 267: IVON02 = 500 00260029 ! 268: RETURN 00270029 ! 269: END 00280029
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.