|
|
1.1 ! root 1: PROGRAM FM517 00010517 ! 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 00020517 ! 6: C THIS PROGRAM TESTS THE RETURN STATEMENT ANS REF. 00030517 ! 7: C RETURN E 15.8.1 00040517 ! 8: C IN SUBROUTINE SUBPROGRAMS. E IS AN ARITHMETIC 15.8.3 00050517 ! 9: C EXPRESSION WHOSE VALUE INDICATES WHERE CONTROL 00060517 ! 10: C WILL BE RETURNED TO. 00070517 ! 11: C 00080517 ! 12: C THIS ROUTINE USES SUBROUTINE SUBPROGRAMS SN518 00090517 ! 13: C AND SN519 00100517 ! 14: C 00110517 ! 15: CBB** ********************** BBCCOMNT **********************************00120517 ! 16: C**** 00130517 ! 17: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140517 ! 18: C**** VERSION 2.0 00150517 ! 19: C**** 00160517 ! 20: C**** 00170517 ! 21: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180517 ! 22: C**** GENERAL SERVICES ADMINISTRATION 00190517 ! 23: C**** FEDERAL SOFTWARE TESTING CENTER 00200517 ! 24: C**** 5203 LEESBURG PIKE, SUITE 1100 00210517 ! 25: C**** FALLS CHURCH, VA. 22041 00220517 ! 26: C**** 00230517 ! 27: C**** (703) 756-6153 00240517 ! 28: C**** 00250517 ! 29: CBE** ********************** BBCCOMNT **********************************00260517 ! 30: IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00270517 ! 31: IMPLICIT CHARACTER*27 (C) 00280517 ! 32: CBB** ********************** BBCINITA **********************************00290517 ! 33: C**** SPECIFICATION STATEMENTS 00300517 ! 34: C**** 00310517 ! 35: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320517 ! 36: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330517 ! 37: CBE** ********************** BBCINITA **********************************00340517 ! 38: C 00350517 ! 39: 00360517 ! 40: C 00370517 ! 41: C 00380517 ! 42: CBB** ********************** BBCINITB **********************************00390517 ! 43: C**** INITIALIZE SECTION 00400517 ! 44: DATA ZVERS, ZVERSD, ZDATE 00410517 ! 45: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00420517 ! 46: DATA ZCOMPL, ZNAME, ZTAPE 00430517 ! 47: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00440517 ! 48: DATA ZPROJ, ZTAPED, ZPROG 00450517 ! 49: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00460517 ! 50: DATA REMRKS /' '/ 00470517 ! 51: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00480517 ! 52: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00490517 ! 53: C**** 00500517 ! 54: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00510517 ! 55: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00520517 ! 56: CZ03 ZPROG = 'PROGRAM NAME' 00530517 ! 57: ZDATE = '07-Nov-85 ' *RP ! 58: ZCOMPL = 'CCI 5.2 ' *RP ! 59: ZPROJ = 'TC-85- -410' *RP ! 60: ZNAME = ' ' *RP ! 61: ZTAPE = ' ' *RP ! 62: ZTAPED = '850703 ' *RP ! 63: C 00600517 ! 64: IVPASS = 0 00610517 ! 65: IVFAIL = 0 00620517 ! 66: IVDELE = 0 00630517 ! 67: IVINSP = 0 00640517 ! 68: IVTOTL = 0 00650517 ! 69: IVTOTN = 0 00660517 ! 70: ICZERO = 0 00670517 ! 71: C 00680517 ! 72: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00690517 ! 73: I01 = 05 00700517 ! 74: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00710517 ! 75: I02 = 06 00720517 ! 76: C 00730517 ! 77: I01 = 5 00740517 ! 78: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750517 ! 79: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00760517 ! 80: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00770517 ! 81: C 00780517 ! 82: I02 = 6 00790517 ! 83: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00800517 ! 84: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00810517 ! 85: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00820517 ! 86: C 00830517 ! 87: CBE** ********************** BBCINITB **********************************00840517 ! 88: ZPROG = 'FM517' 00850517 ! 89: IVTOTL = 5 00860517 ! 90: CBB** ********************** BBCHED0A **********************************00870517 ! 91: C**** 00880517 ! 92: C**** WRITE REPORT TITLE 00890517 ! 93: C**** 00900517 ! 94: WRITE (I02, 90002) 00910517 ! 95: WRITE (I02, 90006) 00920517 ! 96: WRITE (I02, 90007) 00930517 ! 97: WRITE (I02, 90008) ZVERS, ZVERSD 00940517 ! 98: WRITE (I02, 90009) ZPROG, ZPROG 00950517 ! 99: WRITE (I02, 90010) ZDATE, ZCOMPL 00960517 ! 100: CBE** ********************** BBCHED0A **********************************00970517 ! 101: CBB** ********************** BBCHED0B **********************************00980517 ! 102: C**** WRITE DETAIL REPORT HEADERS 00990517 ! 103: C**** 01000517 ! 104: WRITE (I02,90004) 01010517 ! 105: WRITE (I02,90004) 01020517 ! 106: WRITE (I02,90013) 01030517 ! 107: WRITE (I02,90014) 01040517 ! 108: WRITE (I02,90015) IVTOTL 01050517 ! 109: CBE** ********************** BBCHED0B **********************************01060517 ! 110: C TESTS 1 AND 2 TEST RETURN CONTROL PROCESSING IN THE EXECUTION 01070517 ! 111: C OF A SUBROUTINE SUBPROGRAM WHICH PROVIDES ALTERNATE RETURN 01080517 ! 112: C 01090517 ! 113: CT001* TEST 001 **** FCVS PROGRAM 517 **** 01100517 ! 114: C 01110517 ! 115: IVTNUM = 1 01120517 ! 116: IVCOMP = 0 01130517 ! 117: IVCORR = 3 01140517 ! 118: IVN001 = 2 01150517 ! 119: CALL SN518(IVN001,*0012,*0013) 01160517 ! 120: IVCOMP = 1 01170517 ! 121: GO TO 0014 01180517 ! 122: 0012 CONTINUE 01190517 ! 123: IVCOMP = 2 01200517 ! 124: GO TO 0014 01210517 ! 125: 0013 CONTINUE 01220517 ! 126: IVCOMP = 3 01230517 ! 127: 0014 CONTINUE 01240517 ! 128: 40010 IF (IVCOMP - 3) 20010, 10010, 20010 01250517 ! 129: 10010 IVPASS = IVPASS + 1 01260517 ! 130: WRITE (I02,80002) IVTNUM 01270517 ! 131: GO TO 0011 01280517 ! 132: 20010 IVFAIL = IVFAIL + 1 01290517 ! 133: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300517 ! 134: 0011 CONTINUE 01310517 ! 135: C 01320517 ! 136: CT002* TEST 002 **** FCVS PROGRAM 517 **** 01330517 ! 137: C 01340517 ! 138: IVTNUM = 2 01350517 ! 139: IVCOMP = 0 01360517 ! 140: IVCORR = 5 01370517 ! 141: CALL SN519(7,*0022,*0023) 01380517 ! 142: IVCOMP = 1 01390517 ! 143: GO TO 0024 01400517 ! 144: 0022 CONTINUE 01410517 ! 145: IVCOMP = 3 01420517 ! 146: GO TO 0024 01430517 ! 147: 0023 CONTINUE 01440517 ! 148: IVCOMP = 5 01450517 ! 149: 0024 CONTINUE 01460517 ! 150: 40020 IF (IVCOMP - 5) 20020, 10020, 20020 01470517 ! 151: 10020 IVPASS = IVPASS + 1 01480517 ! 152: WRITE (I02,80002) IVTNUM 01490517 ! 153: GO TO 0021 01500517 ! 154: 20020 IVFAIL = IVFAIL + 1 01510517 ! 155: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01520517 ! 156: 0021 CONTINUE 01530517 ! 157: C 01540517 ! 158: CT003* TEST 003 **** FCVS PROGRAM 517 **** 01550517 ! 159: C TEST 003 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 01560517 ! 160: C LESS THAN ONE 01570517 ! 161: C 01580517 ! 162: IVTNUM = 3 01590517 ! 163: IVCOMP = 0 01600517 ! 164: IVCORR = -2 01610517 ! 165: CALL SN518(-3,*0032,*0033) 01620517 ! 166: IVCOMP = -2 01630517 ! 167: GO TO 0034 01640517 ! 168: 0032 CONTINUE 01650517 ! 169: IVCOMP = -4 01660517 ! 170: GO TO 0034 01670517 ! 171: 0033 CONTINUE 01680517 ! 172: IVCOMP = -6 01690517 ! 173: 0034 CONTINUE 01700517 ! 174: 40030 IF (IVCOMP + 2) 20030, 10030, 20030 01710517 ! 175: 10030 IVPASS = IVPASS + 1 01720517 ! 176: WRITE (I02,80002) IVTNUM 01730517 ! 177: GO TO 0031 01740517 ! 178: 20030 IVFAIL = IVFAIL + 1 01750517 ! 179: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01760517 ! 180: 0031 CONTINUE 01770517 ! 181: C 01780517 ! 182: CT004* TEST 004 **** FCVS PROGRAM 517 **** 01790517 ! 183: C TEST 004 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 01800517 ! 184: C GREATER THAN THE NUMBER OF ASTERISKS IN A SUBROUTINE STATEMENT 01810517 ! 185: C 01820517 ! 186: IVTNUM = 4 01830517 ! 187: IVCOMP = 0 01840517 ! 188: IVCORR = 7 01850517 ! 189: CALL SN518(3,*0042,*0043) 01860517 ! 190: IVCOMP = 7 01870517 ! 191: GO TO 0044 01880517 ! 192: 0042 CONTINUE 01890517 ! 193: IVCOMP = 9 01900517 ! 194: GO TO 0044 01910517 ! 195: 0043 CONTINUE 01920517 ! 196: IVCOMP = 11 01930517 ! 197: 0044 CONTINUE 01940517 ! 198: 40040 IF (IVCOMP - 7) 20040, 10040, 20040 01950517 ! 199: 10040 IVPASS = IVPASS + 1 01960517 ! 200: WRITE (I02,80002) IVTNUM 01970517 ! 201: GO TO 0041 01980517 ! 202: 20040 IVFAIL = IVFAIL + 1 01990517 ! 203: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02000517 ! 204: 0041 CONTINUE 02010517 ! 205: C 02020517 ! 206: CT005* TEST 005 **** FCVS PROGRAM 517 **** 02030517 ! 207: C TEST 005 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 02040517 ! 208: C GREATER THAN THE NUMBER OF ASTERISKS IN AN ENTRY STATEMENT 02050517 ! 209: C 02060517 ! 210: IVTNUM = 5 02070517 ! 211: IVCOMP = 0 02080517 ! 212: IVCORR = -10 02090517 ! 213: CALL EN872(9,*0052,*0053) 02100517 ! 214: IVCOMP = -10 02110517 ! 215: GO TO 0054 02120517 ! 216: 0052 CONTINUE 02130517 ! 217: IVCOMP = 3 02140517 ! 218: GO TO 0054 02150517 ! 219: 0053 CONTINUE 02160517 ! 220: IVCOMP = 11 02170517 ! 221: 0054 CONTINUE 02180517 ! 222: 40050 IF (IVCOMP + 10) 20050, 10050, 20050 02190517 ! 223: 10050 IVPASS = IVPASS + 1 02200517 ! 224: WRITE (I02,80002) IVTNUM 02210517 ! 225: GO TO 0051 02220517 ! 226: 20050 IVFAIL = IVFAIL + 1 02230517 ! 227: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02240517 ! 228: 0051 CONTINUE 02250517 ! 229: C 02260517 ! 230: CBB** ********************** BBCSUM0 **********************************02270517 ! 231: C**** WRITE OUT TEST SUMMARY 02280517 ! 232: C**** 02290517 ! 233: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02300517 ! 234: WRITE (I02, 90004) 02310517 ! 235: WRITE (I02, 90014) 02320517 ! 236: WRITE (I02, 90004) 02330517 ! 237: WRITE (I02, 90020) IVPASS 02340517 ! 238: WRITE (I02, 90022) IVFAIL 02350517 ! 239: WRITE (I02, 90024) IVDELE 02360517 ! 240: WRITE (I02, 90026) IVINSP 02370517 ! 241: WRITE (I02, 90028) IVTOTN, IVTOTL 02380517 ! 242: CBE** ********************** BBCSUM0 **********************************02390517 ! 243: CBB** ********************** BBCFOOT0 **********************************02400517 ! 244: C**** WRITE OUT REPORT FOOTINGS 02410517 ! 245: C**** 02420517 ! 246: WRITE (I02,90016) ZPROG, ZPROG 02430517 ! 247: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02440517 ! 248: WRITE (I02,90019) 02450517 ! 249: CBE** ********************** BBCFOOT0 **********************************02460517 ! 250: 90001 FORMAT (1H ,56X,5HFM517) 02470517 ! 251: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM517) 02480517 ! 252: CBB** ********************** BBCFMT0A **********************************02490517 ! 253: C**** FORMATS FOR TEST DETAIL LINES 02500517 ! 254: C**** 02510517 ! 255: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 02520517 ! 256: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 02530517 ! 257: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 02540517 ! 258: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 02550517 ! 259: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 02560517 ! 260: 1I6,/,1H ,15X,10HCORRECT= ,I6) 02570517 ! 261: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02580517 ! 262: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 02590517 ! 263: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02600517 ! 264: 1A21,/,1H ,16X,10HCORRECT= ,A21) 02610517 ! 265: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 02620517 ! 266: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 02630517 ! 267: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 02640517 ! 268: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 02650517 ! 269: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 02660517 ! 270: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 02670517 ! 271: 80050 FORMAT (1H ,48X,A31) 02680517 ! 272: CBE** ********************** BBCFMT0A **********************************02690517 ! 273: CBB** ********************** BBCFMAT1 **********************************02700517 ! 274: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02710517 ! 275: C**** 02720517 ! 276: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02730517 ! 277: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 02740517 ! 278: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 02750517 ! 279: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 02760517 ! 280: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 02770517 ! 281: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 02780517 ! 282: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 02790517 ! 283: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 02800517 ! 284: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02810517 ! 285: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 02820517 ! 286: 21H(,F12.5,2H, ,F12.5,1H)) 02830517 ! 287: CBE** ********************** BBCFMAT1 **********************************02840517 ! 288: CBB** ********************** BBCFMT0B **********************************02850517 ! 289: C**** FORMAT STATEMENTS FOR PAGE HEADERS 02860517 ! 290: C**** 02870517 ! 291: 90002 FORMAT (1H1) 02880517 ! 292: 90004 FORMAT (1H ) 02890517 ! 293: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 02900517 ! 294: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02910517 ! 295: 90008 FORMAT (1H ,21X,A13,A17) 02920517 ! 296: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 02930517 ! 297: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 02940517 ! 298: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 02950517 ! 299: 1 7X,7HREMARKS,24X) 02960517 ! 300: 90014 FORMAT (1H ,46H----------------------------------------------, 02970517 ! 301: 1 33H---------------------------------) 02980517 ! 302: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 02990517 ! 303: C**** 03000517 ! 304: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03010517 ! 305: C**** 03020517 ! 306: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 03030517 ! 307: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 03040517 ! 308: 1 A13) 03050517 ! 309: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 03060517 ! 310: C**** 03070517 ! 311: C**** FORMAT STATEMENTS FOR RUN SUMMARY 03080517 ! 312: C**** 03090517 ! 313: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 03100517 ! 314: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 03110517 ! 315: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 03120517 ! 316: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 03130517 ! 317: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 03140517 ! 318: CBE** ********************** BBCFMT0B **********************************03150517 ! 319: STOP 03160517 ! 320: END 03170517 ! 321: C 00010518 ! 322: C DATE***82/08/02*18.33.46 ! 323: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 324: C AUDIT FCVS78 V2.0 ! 325: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 517 00020518 ! 326: C 00030518 ! 327: C THIS SUBROUTINE TESTS THE USE OF THE "RETURN E" STATEMENT 00040518 ! 328: C WHERE E IS AN INTEGER VARIABLE 00050518 ! 329: C 00060518 ! 330: SUBROUTINE SN518(IVD001,*,*) 00070518 ! 331: RETURN IVD001 00080518 ! 332: END 00090518 ! 333: C 00010519 ! 334: C DATE***82/08/02*18.33.46 ! 335: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 336: C AUDIT FCVS78 V2.0 ! 337: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 517 00020519 ! 338: C 00030519 ! 339: C THIS SUBROUTINE TESTS THE USE OF THE "RETURN E" STATEMENT 00040519 ! 340: C WHERE E IS AN INTEGER EXPRESSION 00050519 ! 341: C 00060519 ! 342: SUBROUTINE SN519(IVD001,*,*) 00070519 ! 343: RETURN (IVD001 - 2*(IVD001/2) + 1) 00080519 ! 344: ENTRY EN872(IVD002,*,*) 00090519 ! 345: RETURN (IVD002 - 3) 00100519 ! 346: END 00110519
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.