|
|
1.1 ! root 1: PROGRAM FM254 00010254 ! 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 00020254 ! 6: C 00030254 ! 7: C 00040254 ! 8: C THIS ROUTINE IS A TEST OF THE ELSE IF-BLOCK. TESTS WITHIN THIS00050254 ! 9: C ROUTINE ARE FOR THE SYNTAX OF THE BASIC ELSE IF STATEMENT AND 00060254 ! 10: C ELSE IF-BLOCK STRUCTURE. 00070254 ! 11: C 00080254 ! 12: C REFERENCES 00090254 ! 13: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00100254 ! 14: C X3.9-1977 00110254 ! 15: C SECTION 11.7, ELSE IF STATEMENT 00120254 ! 16: C SECTION 11.7.1, ELSE IF-BLOCK 00130254 ! 17: C SECTION 11.7.2, EXECUTION OF THE ELSE IF STATEMENT 00140254 ! 18: C 00150254 ! 19: C 00160254 ! 20: C 00170254 ! 21: C 00180254 ! 22: C ******************************************************************00190254 ! 23: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200254 ! 24: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00210254 ! 25: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00220254 ! 26: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00230254 ! 27: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00240254 ! 28: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00250254 ! 29: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00260254 ! 30: C THE RESULT OF EXECUTING THESE TESTS. 00270254 ! 31: C 00280254 ! 32: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00290254 ! 33: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00300254 ! 34: C 00310254 ! 35: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00320254 ! 36: C DEPARTMENT OF THE NAVY 00330254 ! 37: C FEDERAL COBOL COMPILER TESTING SERVICE 00340254 ! 38: C WASHINGTON, D.C. 20376 00350254 ! 39: C 00360254 ! 40: C ******************************************************************00370254 ! 41: C 00380254 ! 42: C 00390254 ! 43: IMPLICIT LOGICAL (L) 00400254 ! 44: IMPLICIT CHARACTER*14 (C) 00410254 ! 45: C 00420254 ! 46: DIMENSION LADN11(2) 00430254 ! 47: LOGICAL LVTN01, LVTN02, LATN11(2), LADN11 00440254 ! 48: DATA LADN11/.TRUE., .FALSE./ 00450254 ! 49: C 00460254 ! 50: C 00470254 ! 51: C **** LOGICAL STATEMENT FUNCTION REFERENCED IN TEST 4 **** 00480254 ! 52: C 00490254 ! 53: LFIS01 ( L ) = L .AND. L 00500254 ! 54: C 00510254 ! 55: C 00520254 ! 56: C 00530254 ! 57: C 00540254 ! 58: C 00550254 ! 59: C INITIALIZATION SECTION. 00560254 ! 60: C 00570254 ! 61: C INITIALIZE CONSTANTS 00580254 ! 62: C ******************** 00590254 ! 63: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00600254 ! 64: I01 = 5 00610254 ! 65: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00620254 ! 66: I02 = 6 00630254 ! 67: C SYSTEM ENVIRONMENT SECTION 00640254 ! 68: C 00650254 ! 69: I01 = 5 00660254 ! 70: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670254 ! 71: C (UNIT NUMBER FOR CARD READER). 00680254 ! 72: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00690254 ! 73: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00700254 ! 74: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00710254 ! 75: C 00720254 ! 76: I02 = 6 00730254 ! 77: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00740254 ! 78: C (UNIT NUMBER FOR PRINTER). 00750254 ! 79: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00760254 ! 80: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770254 ! 81: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00780254 ! 82: C 00790254 ! 83: IVPASS = 0 00800254 ! 84: IVFAIL = 0 00810254 ! 85: IVDELE = 0 00820254 ! 86: ICZERO = 0 00830254 ! 87: C 00840254 ! 88: C WRITE OUT PAGE HEADERS 00850254 ! 89: C 00860254 ! 90: WRITE (I02,90002) 00870254 ! 91: WRITE (I02,90006) 00880254 ! 92: WRITE (I02,90008) 00890254 ! 93: WRITE (I02,90004) 00900254 ! 94: WRITE (I02,90010) 00910254 ! 95: WRITE (I02,90004) 00920254 ! 96: WRITE (I02,90016) 00930254 ! 97: WRITE (I02,90001) 00940254 ! 98: WRITE (I02,90004) 00950254 ! 99: WRITE (I02,90012) 00960254 ! 100: WRITE (I02,90014) 00970254 ! 101: WRITE (I02,90004) 00980254 ! 102: C 00990254 ! 103: C 01000254 ! 104: C 01010254 ! 105: C THE SYNTAX OF THE ELSE IF STATEMENTS IN THE TESTS TO FOLLOW IS 01020254 ! 106: C 01030254 ! 107: C IF ( E1 ) THEN 01040254 ! 108: C IF-BLOCK 01050254 ! 109: C ELSE IF ( E2 ) THEN 01060254 ! 110: C ELSE IF-BLOCK 01070254 ! 111: C END IF 01080254 ! 112: C 01090254 ! 113: C THE NEXT FOUR TESTS WILL USE THE FOLLOWING COMBINATIONS OF TRUE 01100254 ! 114: C AND FALSE FOR E1 AND E2 AS SHOWN BELOW - 01110254 ! 115: C TEST NUMBER 1 2 3 4 01120254 ! 116: C E1 F F T T 01130254 ! 117: C E2 T F T F 01140254 ! 118: C 01150254 ! 119: C 01160254 ! 120: C 01170254 ! 121: C 01180254 ! 122: C **** FCVS PROGRAM 254 - TEST 001 **** 01190254 ! 123: C 01200254 ! 124: C TEST 001 USES A VERY SIMPLE ELSE IF STATEMENT. THE EXPRESSION 01210254 ! 125: C WITHIN THE PARENTHESES IS THE LOGICAL CONSTANT .TRUE. AND THE 01220254 ! 126: C EXECUTABLE STATEMENT WITHIN THE ELSE IF-BLOCK OF LEVEL ONE IS AN 01230254 ! 127: C INTEGER ARITHMETIC ASSIGNMENT STATEMENT. IN THIS TEST THE LOGICAL01240254 ! 128: C EXPRESSION E1 IS .FALSE. SO THE IF-BLOCK SHOULD NOT BE EXECUTED. 01250254 ! 129: C THE LOGICAL EXPRESSION E2 IS .TRUE. SO THE ELSE IF-BLOCK SHOULD 01260254 ! 130: C BE EXECUTED. 01270254 ! 131: C 01280254 ! 132: C 01290254 ! 133: IVTNUM = 1 01300254 ! 134: IF (ICZERO) 30010, 0010, 30010 01310254 ! 135: 0010 CONTINUE 01320254 ! 136: IVCOMP = 1 01330254 ! 137: IF ( .FALSE. ) THEN 01340254 ! 138: IVCOMP = IVCOMP * 2 01350254 ! 139: ELSE IF ( .TRUE. ) THEN 01360254 ! 140: IVCOMP = IVCOMP * 3 01370254 ! 141: END IF 01380254 ! 142: C 01390254 ! 143: C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 01400254 ! 144: C 01410254 ! 145: IVCORR = 3 01420254 ! 146: 40010 IF ( IVCOMP - 3 ) 20010, 10010, 20010 01430254 ! 147: 30010 IVDELE = IVDELE + 1 01440254 ! 148: WRITE (I02,80000) IVTNUM 01450254 ! 149: IF (ICZERO) 10010, 0021, 20010 01460254 ! 150: 10010 IVPASS = IVPASS + 1 01470254 ! 151: WRITE (I02,80002) IVTNUM 01480254 ! 152: GO TO 0021 01490254 ! 153: 20010 IVFAIL = IVFAIL + 1 01500254 ! 154: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01510254 ! 155: 0021 CONTINUE 01520254 ! 156: C 01530254 ! 157: C **** FCVS PROGRAM 254 - TEST 002 **** 01540254 ! 158: C 01550254 ! 159: C TEST 002 HAS E1 .FALSE. AND E2 .FALSE.. NEITHER THE IF-BLOCK 01560254 ! 160: C NOR THE ELSE IF-BLOCK SHOULD BE EXECUTED. 01570254 ! 161: C 01580254 ! 162: C 01590254 ! 163: IVTNUM = 2 01600254 ! 164: IF (ICZERO) 30020, 0020, 30020 01610254 ! 165: 0020 CONTINUE 01620254 ! 166: IVCOMP = 1 01630254 ! 167: LVON01 = .FALSE. 01640254 ! 168: LVON02 = .FALSE. 01650254 ! 169: IF ( LVON01 ) THEN 01660254 ! 170: IVCOMP = IVCOMP * 2 01670254 ! 171: ELSE IF ( LVON02 ) THEN 01680254 ! 172: IVCOMP = IVCOMP * 3 01690254 ! 173: END IF 01700254 ! 174: IVCORR = 1 01710254 ! 175: 40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020 01720254 ! 176: 30020 IVDELE = IVDELE + 1 01730254 ! 177: WRITE (I02,80000) IVTNUM 01740254 ! 178: IF (ICZERO) 10020, 0031, 20020 01750254 ! 179: 10020 IVPASS = IVPASS + 1 01760254 ! 180: WRITE (I02,80002) IVTNUM 01770254 ! 181: GO TO 0031 01780254 ! 182: 20020 IVFAIL = IVFAIL + 1 01790254 ! 183: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01800254 ! 184: 0031 CONTINUE 01810254 ! 185: C 01820254 ! 186: C **** FCVS PROGRAM 254 - TEST 003 **** 01830254 ! 187: C 01840254 ! 188: C TEST 003 HAS E1 AS .TRUE. AND E2 AS .TRUE.. ONLY THE IF-BLOCK 01850254 ! 189: C SHOULD BE EXECUTED. THE ELSE IF-BLOCK SHOULD NOT BE EXECUTED. 01860254 ! 190: C 01870254 ! 191: C 01880254 ! 192: IVTNUM = 3 01890254 ! 193: IF (ICZERO) 30030, 0030, 30030 01900254 ! 194: 0030 CONTINUE 01910254 ! 195: IVCOMP = 1 01920254 ! 196: LVON01 = .TRUE. 01930254 ! 197: LVON02 = .TRUE. 01940254 ! 198: LVTN01 = LVON01 01950254 ! 199: LVTN02 = LVON02 01960254 ! 200: IF ( LVTN01 ) THEN 01970254 ! 201: IVCOMP = IVCOMP * 2 01980254 ! 202: ELSE IF ( LVTN02 ) THEN 01990254 ! 203: IVCOMP = IVCOMP * 3 02000254 ! 204: END IF 02010254 ! 205: C 02020254 ! 206: C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****02030254 ! 207: C 02040254 ! 208: IVCORR = 2 02050254 ! 209: 40030 IF ( IVCOMP - 2 ) 20030, 10030, 20030 02060254 ! 210: 30030 IVDELE = IVDELE + 1 02070254 ! 211: WRITE (I02,80000) IVTNUM 02080254 ! 212: IF (ICZERO) 10030, 0041, 20030 02090254 ! 213: 10030 IVPASS = IVPASS + 1 02100254 ! 214: WRITE (I02,80002) IVTNUM 02110254 ! 215: GO TO 0041 02120254 ! 216: 20030 IVFAIL = IVFAIL + 1 02130254 ! 217: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02140254 ! 218: 0041 CONTINUE 02150254 ! 219: C 02160254 ! 220: C **** FCVS PROGRAM 254 - TEST 004 **** 02170254 ! 221: C 02180254 ! 222: C TEST 004 HAS E1 AS .TRUE. AND E2 AS .FALSE.. ONLY THE IF-BLOCK02190254 ! 223: C SHOULD BE EXECUTED. THE ELSE IF-BLOCK SHOULD NOT BE EXECUTED. 02200254 ! 224: C 02210254 ! 225: C 02220254 ! 226: IVTNUM = 4 02230254 ! 227: IF (ICZERO) 30040, 0040, 30040 02240254 ! 228: 0040 CONTINUE 02250254 ! 229: IVCOMP = 1 02260254 ! 230: LVON01 = .TRUE. 02270254 ! 231: LVTN01 = LFIS01 ( LVON01 ) 02280254 ! 232: LVON02 = .FALSE. 02290254 ! 233: IF ( LVTN01 ) THEN 02300254 ! 234: IVCOMP = IVCOMP * 2 02310254 ! 235: ELSE IF ( LFIS01 ( LVON02 ) ) THEN 02320254 ! 236: IVCOMP = IVCOMP * 3 02330254 ! 237: END IF 02340254 ! 238: C 02350254 ! 239: C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****02360254 ! 240: C 02370254 ! 241: IVCORR = 2 02380254 ! 242: 40040 IF ( IVCOMP - 2 ) 20040, 10040, 20040 02390254 ! 243: 30040 IVDELE = IVDELE + 1 02400254 ! 244: WRITE (I02,80000) IVTNUM 02410254 ! 245: IF (ICZERO) 10040, 0051, 20040 02420254 ! 246: 10040 IVPASS = IVPASS + 1 02430254 ! 247: WRITE (I02,80002) IVTNUM 02440254 ! 248: GO TO 0051 02450254 ! 249: 20040 IVFAIL = IVFAIL + 1 02460254 ! 250: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02470254 ! 251: 0051 CONTINUE 02480254 ! 252: C 02490254 ! 253: C 02500254 ! 254: C THE SYNTAX OF THE ELSE IF STATEMENTS IN THE TESTS TO FOLLOW IS 02510254 ! 255: C 02520254 ! 256: C IF ( E1 ) THEN 02530254 ! 257: C IF-BLOCK 1 02540254 ! 258: C ELSE IF ( E2 ) THEN 02550254 ! 259: C ELSE IF-BLOCK 1 02560254 ! 260: C ELSE IF ( E3 ) THEN 02570254 ! 261: C ELSE IF-BLOCK 2 02580254 ! 262: C END IF 02590254 ! 263: C 02600254 ! 264: C 02610254 ! 265: C 02620254 ! 266: C **** FCVS PROGRAM 254 - TEST 005 **** 02630254 ! 267: C 02640254 ! 268: C TEST 005 HAS E1 AS TRUE. E2 AND E3 ARE FALSE. ONLY IF-BLOCK 102650254 ! 269: C SHOULD BE EXECUTED. ELSE IF-BLOCKS 1 AND 2 SHOULD NOT EXECUTE. 02660254 ! 270: C 02670254 ! 271: C 02680254 ! 272: IVTNUM = 5 02690254 ! 273: IF (ICZERO) 30050, 0050, 30050 02700254 ! 274: 0050 CONTINUE 02710254 ! 275: IVCOMP = 1 02720254 ! 276: C LADN11(1) IS SET TO .TRUE. IN A DATA STATEMENT. 02730254 ! 277: LVON02 = .FALSE. 02740254 ! 278: LVON03 = .FALSE. 02750254 ! 279: IF ( LADN11(1) ) THEN 02760254 ! 280: IVCOMP = IVCOMP * 2 02770254 ! 281: ELSE IF ( LVON02 ) THEN 02780254 ! 282: IVCOMP = IVCOMP * 3 02790254 ! 283: ELSE IF ( LVON03 ) THEN 02800254 ! 284: IVCOMP = IVCOMP * 5 02810254 ! 285: END IF 02820254 ! 286: C 02830254 ! 287: C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****02840254 ! 288: C 02850254 ! 289: IVCORR = 2 02860254 ! 290: 40050 IF ( IVCOMP - 2 ) 20050, 10050, 20050 02870254 ! 291: 30050 IVDELE = IVDELE + 1 02880254 ! 292: WRITE (I02,80000) IVTNUM 02890254 ! 293: IF (ICZERO) 10050, 0061, 20050 02900254 ! 294: 10050 IVPASS = IVPASS + 1 02910254 ! 295: WRITE (I02,80002) IVTNUM 02920254 ! 296: GO TO 0061 02930254 ! 297: 20050 IVFAIL = IVFAIL + 1 02940254 ! 298: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02950254 ! 299: 0061 CONTINUE 02960254 ! 300: C 02970254 ! 301: C **** FCVS PROGRAM 254 - TEST 006 **** 02980254 ! 302: C 02990254 ! 303: C TEST 006 HAS E1 AS FALSE, E2 AS TRUE, AND E3 AS FALSE. ONLY 03000254 ! 304: C ELSE IF-BLOCK 1 SHOULD EXECUTE. IF-BLOCK 1 AND ELSE IF-BLOCK 2 03010254 ! 305: C SHOULD NOT EXECUTE. 03020254 ! 306: C 03030254 ! 307: C 03040254 ! 308: IVTNUM = 6 03050254 ! 309: IF (ICZERO) 30060, 0060, 30060 03060254 ! 310: 0060 CONTINUE 03070254 ! 311: IVCOMP = 1 03080254 ! 312: LVON01 = .FALSE. 03090254 ! 313: LATN11(2) = .TRUE. 03100254 ! 314: LVON03 = .FALSE. 03110254 ! 315: IF ( LVON01 ) THEN 03120254 ! 316: IVCOMP = IVCOMP * 2 03130254 ! 317: ELSE IF ( LATN11(2) ) THEN 03140254 ! 318: IVCOMP = IVCOMP * 3 03150254 ! 319: ELSE IF ( LVON03 ) THEN 03160254 ! 320: IVCOMP = IVCOMP * 5 03170254 ! 321: END IF 03180254 ! 322: C 03190254 ! 323: C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****03200254 ! 324: C 03210254 ! 325: IVCORR = 3 03220254 ! 326: 40060 IF ( IVCOMP - 3 ) 20060, 10060, 20060 03230254 ! 327: 30060 IVDELE = IVDELE + 1 03240254 ! 328: WRITE (I02,80000) IVTNUM 03250254 ! 329: IF (ICZERO) 10060, 0071, 20060 03260254 ! 330: 10060 IVPASS = IVPASS + 1 03270254 ! 331: WRITE (I02,80002) IVTNUM 03280254 ! 332: GO TO 0071 03290254 ! 333: 20060 IVFAIL = IVFAIL + 1 03300254 ! 334: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03310254 ! 335: 0071 CONTINUE 03320254 ! 336: C 03330254 ! 337: C **** FCVS PROGRAM 254 - TEST 007 **** 03340254 ! 338: C 03350254 ! 339: C TEST 007 HAS E1 AS FALSE, E2 AS FALSE, AND E3 AS TRUE. ONLY 03360254 ! 340: C ELSE IF-BLOCK 2 SHOULD BE EXECUTED. IF-BLOCK 1 AND ELSE IF-BLOCK 03370254 ! 341: C 1 SHOULD NOT EXECUTE. 03380254 ! 342: C 03390254 ! 343: C 03400254 ! 344: IVTNUM = 7 03410254 ! 345: IF (ICZERO) 30070, 0070, 30070 03420254 ! 346: 0070 CONTINUE 03430254 ! 347: IVCOMP = 1 03440254 ! 348: LVON01 = .FALSE. 03450254 ! 349: LVON02 = .FALSE. 03460254 ! 350: LVON03 = .TRUE. 03470254 ! 351: IF ( LVON01 ) THEN 03480254 ! 352: IVCOMP = IVCOMP * 2 03490254 ! 353: ELSE IF ( LVON02 ) THEN 03500254 ! 354: IVCOMP = IVCOMP * 3 03510254 ! 355: ELSE IF ( LVON03 ) THEN 03520254 ! 356: IVCOMP = IVCOMP * 5 03530254 ! 357: END IF 03540254 ! 358: C 03550254 ! 359: C **** IVCOMP IS DETERMINED BY IVCOMP = 5 = 1 * 5 ****03560254 ! 360: C 03570254 ! 361: IVCORR = 5 03580254 ! 362: 40070 IF ( IVCOMP - 5 ) 20070, 10070, 20070 03590254 ! 363: 30070 IVDELE = IVDELE + 1 03600254 ! 364: WRITE (I02,80000) IVTNUM 03610254 ! 365: IF (ICZERO) 10070, 0081, 20070 03620254 ! 366: 10070 IVPASS = IVPASS + 1 03630254 ! 367: WRITE (I02,80002) IVTNUM 03640254 ! 368: GO TO 0081 03650254 ! 369: 20070 IVFAIL = IVFAIL + 1 03660254 ! 370: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03670254 ! 371: 0081 CONTINUE 03680254 ! 372: C 03690254 ! 373: C **** FCVS PROGRAM 254 - TEST 008 **** 03700254 ! 374: C 03710254 ! 375: C TEST 008 HAS E1 AS FALSE. BOTH E2 AND E3 ARE TRUE. ONLY ELSE 03720254 ! 376: C IF-BLOCK 1 SHOULD EXECUTE. IF-BLOCK 1 AND ELSE IF-BLOCK 2 SHOULD 03730254 ! 377: C NOT EXECUTE. THIS IS A TEST OF THE LOGIC FLOW WHEN ONE OF THE 03740254 ! 378: C EXPRESSIONS IN A STRING OF ELSE IF BLOCK STRUCTURES IS TRUE. ONLY03750254 ! 379: C THAT PARTICULAR ELSE IF-BLOCK SHOULD BE EXECUTED. THE REST OF THE03760254 ! 380: C STRING SHOULD BE SKIPPED. 03770254 ! 381: C 03780254 ! 382: C 03790254 ! 383: IVTNUM = 8 03800254 ! 384: IF (ICZERO) 30080, 0080, 30080 03810254 ! 385: 0080 CONTINUE 03820254 ! 386: IVCOMP = 1 03830254 ! 387: LVON01 = .FALSE. 03840254 ! 388: LVON02 = .TRUE. 03850254 ! 389: LVON03 = .TRUE. 03860254 ! 390: IF ( LVON01 ) THEN 03870254 ! 391: IVCOMP = IVCOMP * 2 03880254 ! 392: ELSE IF ( LVON02 ) THEN 03890254 ! 393: IVCOMP = IVCOMP * 3 03900254 ! 394: ELSE IF ( LVON03 ) THEN 03910254 ! 395: IVCOMP = IVCOMP * 5 03920254 ! 396: END IF 03930254 ! 397: C 03940254 ! 398: C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****03950254 ! 399: C 03960254 ! 400: IVCORR = 3 03970254 ! 401: 40080 IF ( IVCOMP - 3 ) 20080, 10080, 20080 03980254 ! 402: 30080 IVDELE = IVDELE + 1 03990254 ! 403: WRITE (I02,80000) IVTNUM 04000254 ! 404: IF (ICZERO) 10080, 0091, 20080 04010254 ! 405: 10080 IVPASS = IVPASS + 1 04020254 ! 406: WRITE (I02,80002) IVTNUM 04030254 ! 407: GO TO 0091 04040254 ! 408: 20080 IVFAIL = IVFAIL + 1 04050254 ! 409: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04060254 ! 410: 0091 CONTINUE 04070254 ! 411: C 04080254 ! 412: C 04090254 ! 413: C THE FOLLOWING TWO TESTS ARE TO CHECK THE EXECUTION OF AN ELSE 04100254 ! 414: C IF STATEMENT WITH AN EMPTY ELSE IF-BLOCK. THE SYNTAX FOR THE TWO 04110254 ! 415: C TESTS IS AS FOLLOWS - 04120254 ! 416: C 04130254 ! 417: C IF ( E1 ) THEN 04140254 ! 418: C IF-BLOCK 1 04150254 ! 419: C ELSE IF ( E2 ) THEN 04160254 ! 420: C ELSE IF ( E3 ) THEN 04170254 ! 421: C ELSE IF-BLOCK 1 04180254 ! 422: C END IF 04190254 ! 423: C 04200254 ! 424: C 04210254 ! 425: C 04220254 ! 426: C **** FCVS PROGRAM 254 - TEST 009 **** 04230254 ! 427: C 04240254 ! 428: C TEST 009 HAS E1 FALSE, E2 TRUE, AND E3 AS TRUE. THE STRUCTURE 04250254 ! 429: C ELSE IF ( E2 ) THEN 04260254 ! 430: C IS FOLLOWED BY AN EMPTY ELSE IF-BLOCK ALLOWED IN SECTION 11.7.1. 04270254 ! 431: C IN SECTION 11.7.2, IF THE VALUE OF THE EXPRESSION IS TRUE AND THE04280254 ! 432: C ELSE IF-BLOCK IS EMPTY, CONTROL IS TRANSFERRED TO THE NEXT END IF 04290254 ! 433: C STATEMENT THAT HAS THE SAME IF-LEVEL AS THE ELSE IF STATEMENT. 04300254 ! 434: C NEITHER IF-BLOCK 1 NOR ELSE IF-BLOCK 1 SHOULD BE EXECUTED. 04310254 ! 435: C 04320254 ! 436: C 04330254 ! 437: IVTNUM = 9 04340254 ! 438: IF (ICZERO) 30090, 0090, 30090 04350254 ! 439: 0090 CONTINUE 04360254 ! 440: IVCOMP = 1 04370254 ! 441: LVON01 = .FALSE. 04380254 ! 442: LVON02 = .TRUE. 04390254 ! 443: LVON03 = .TRUE. 04400254 ! 444: IF ( LVON01 ) THEN 04410254 ! 445: IVCOMP = IVCOMP * 2 04420254 ! 446: ELSE IF ( LVON02 ) THEN 04430254 ! 447: ELSE IF ( LVON03 ) THEN 04440254 ! 448: IVCOMP = IVCOMP * 3 04450254 ! 449: END IF 04460254 ! 450: IVCORR = 1 04470254 ! 451: 40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090 04480254 ! 452: 30090 IVDELE = IVDELE + 1 04490254 ! 453: WRITE (I02,80000) IVTNUM 04500254 ! 454: IF (ICZERO) 10090, 0101, 20090 04510254 ! 455: 10090 IVPASS = IVPASS + 1 04520254 ! 456: WRITE (I02,80002) IVTNUM 04530254 ! 457: GO TO 0101 04540254 ! 458: 20090 IVFAIL = IVFAIL + 1 04550254 ! 459: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04560254 ! 460: 0101 CONTINUE 04570254 ! 461: C 04580254 ! 462: C **** FCVS PROGRAM 254 - TEST 010 **** 04590254 ! 463: C 04600254 ! 464: C TEST 010 ALSO HAS AN EMPTY ELSE IF-BLOCK. E1 AND E2 ARE FALSE.04610254 ! 465: C E3 IS TRUE. ONLY ELSE IF-BLOCK 1 SHOULD BE EXECUTED. IF-BLOCK 1 04620254 ! 466: C SHOULD NOT BE EXECUTED. IN SECTION 11.7.2, IF THE VALUE OF THE 04630254 ! 467: C EXPRESSION IS FALSE, CONTROL IS TRANSFERRED TO THE NEXT ELSE IF, 04640254 ! 468: C ELSE, OR END IF STATEMENT THAT HAS THE SAME IF-LEVEL AS THE ELSE 04650254 ! 469: C IF STATEMENT. 04660254 ! 470: C 04670254 ! 471: C 04680254 ! 472: IVTNUM = 10 04690254 ! 473: IF (ICZERO) 30100, 0100, 30100 04700254 ! 474: 0100 CONTINUE 04710254 ! 475: IVCOMP = 1 04720254 ! 476: LVON01 = .FALSE. 04730254 ! 477: LVON02 = .FALSE. 04740254 ! 478: LVON03 = .TRUE. 04750254 ! 479: IF ( LVON01 ) THEN 04760254 ! 480: IVCOMP = IVCOMP * 2 04770254 ! 481: ELSE IF ( LVON02 ) THEN 04780254 ! 482: ELSE IF ( LVON03 ) THEN 04790254 ! 483: IVCOMP = IVCOMP * 3 04800254 ! 484: END IF 04810254 ! 485: C 04820254 ! 486: C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****04830254 ! 487: C 04840254 ! 488: IVCORR = 3 04850254 ! 489: 40100 IF ( IVCOMP - 3 ) 20100, 10100, 20100 04860254 ! 490: 30100 IVDELE = IVDELE + 1 04870254 ! 491: WRITE (I02,80000) IVTNUM 04880254 ! 492: IF (ICZERO) 10100, 0111, 20100 04890254 ! 493: 10100 IVPASS = IVPASS + 1 04900254 ! 494: WRITE (I02,80002) IVTNUM 04910254 ! 495: GO TO 0111 04920254 ! 496: 20100 IVFAIL = IVFAIL + 1 04930254 ! 497: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04940254 ! 498: 0111 CONTINUE 04950254 ! 499: C 04960254 ! 500: C 04970254 ! 501: C THE NEXT TWO TESTS USE THE ELSE IF STRUCTURE INSIDE A BLOCKED 04980254 ! 502: C IF STRUCTURE OF LEVEL 2 AS FOLLOWS - 04990254 ! 503: C 05000254 ! 504: C IF ( E1 ) THEN 05010254 ! 505: C IF-BLOCK 1 05020254 ! 506: C IF ( E2 ) THEN 05030254 ! 507: C IF-BLOCK 2 05040254 ! 508: C ELSE IF ( E3 ) THEN 05050254 ! 509: C ELSE IF-BLOCK 1 05060254 ! 510: C ELSE IF ( E4 ) THEN 05070254 ! 511: C ELSE IF-BLOCK 2 05080254 ! 512: C END IF 05090254 ! 513: C ELSE IF ( E5 ) THEN 05100254 ! 514: C ELSE IF-BLOCK 3 05110254 ! 515: C ELSE IF ( E6 ) THEN 05120254 ! 516: C ELSE IF-BLOCK 4 05130254 ! 517: C END IF 05140254 ! 518: C 05150254 ! 519: C 05160254 ! 520: C 05170254 ! 521: C **** FCVS PROGRAM 254 - TEST 011 **** 05180254 ! 522: C 05190254 ! 523: C TEST 011 HAS E1 TRUE, E2 AND E3 AS FALSE, E4, E5, AND ALSO 05200254 ! 524: C E6 AS TRUE. IF-BLOCK 1, AND ELSE IF-BLOCK 2 SHOULD BE EXECUTED. 05210254 ! 525: C IF-BLOCK 2, ELSE IF-BLOCK 1, 3, AND 4 SHOULD NOT BE EXECUTED. 05220254 ! 526: C 05230254 ! 527: C 05240254 ! 528: IVTNUM = 11 05250254 ! 529: IF (ICZERO) 30110, 0110, 30110 05260254 ! 530: 0110 CONTINUE 05270254 ! 531: IVCOMP = 1 05280254 ! 532: LVON01 = .TRUE. 05290254 ! 533: LVON02 = .FALSE. 05300254 ! 534: LVON03 = .FALSE. 05310254 ! 535: LVON04 = .TRUE. 05320254 ! 536: LVON05 = .TRUE. 05330254 ! 537: LVON06 = .TRUE. 05340254 ! 538: IF ( LVON01 ) THEN 05350254 ! 539: IVCOMP = IVCOMP * 2 05360254 ! 540: IF ( LVON02 ) THEN 05370254 ! 541: IVCOMP = IVCOMP * 3 05380254 ! 542: ELSE IF ( LVON03 ) THEN 05390254 ! 543: IVCOMP = IVCOMP * 5 05400254 ! 544: ELSE IF ( LVON04 ) THEN 05410254 ! 545: IVCOMP = IVCOMP * 7 05420254 ! 546: END IF 05430254 ! 547: ELSE IF ( LVON05 ) THEN 05440254 ! 548: IVCOMP = IVCOMP * 11 05450254 ! 549: ELSE IF ( LVON06 ) THEN 05460254 ! 550: IVCOMP = IVCOMP * 13 05470254 ! 551: END IF 05480254 ! 552: C 05490254 ! 553: C **** IVCOMP IS DETERMINED BY IVCOMP = 14 = 1 * 2 * 7 ****05500254 ! 554: C 05510254 ! 555: IVCORR = 14 05520254 ! 556: 40110 IF ( IVCOMP - 14 ) 20110, 10110, 20110 05530254 ! 557: 30110 IVDELE = IVDELE + 1 05540254 ! 558: WRITE (I02,80000) IVTNUM 05550254 ! 559: IF (ICZERO) 10110, 0121, 20110 05560254 ! 560: 10110 IVPASS = IVPASS + 1 05570254 ! 561: WRITE (I02,80002) IVTNUM 05580254 ! 562: GO TO 0121 05590254 ! 563: 20110 IVFAIL = IVFAIL + 1 05600254 ! 564: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05610254 ! 565: 0121 CONTINUE 05620254 ! 566: C 05630254 ! 567: C **** FCVS PROGRAM 254 - TEST 012 **** 05640254 ! 568: C 05650254 ! 569: C TEST 012 HAS E1 AS FALSE, E2, E3, AND E4 ARE TRUE, E5 AS FALSE,05660254 ! 570: C AND E6 IS TRUE. ONLY ELSE IF-BLOCK 4 SHOULD BE EXECUTED. NO 05670254 ! 571: C OTHER IF-BLOCK OR ELSE IF-BLOCK SHOULD BE EXECUTED. 05680254 ! 572: C 05690254 ! 573: C 05700254 ! 574: IVTNUM = 12 05710254 ! 575: IF (ICZERO) 30120, 0120, 30120 05720254 ! 576: 0120 CONTINUE 05730254 ! 577: IVCOMP = 1 05740254 ! 578: LVON01 = .FALSE. 05750254 ! 579: LVON02 = .TRUE. 05760254 ! 580: LVON03 = .TRUE. 05770254 ! 581: LVON04 = .TRUE. 05780254 ! 582: LVON05 = .FALSE. 05790254 ! 583: LVON06 = .TRUE. 05800254 ! 584: IF ( LVON01 ) THEN 05810254 ! 585: IVCOMP = IVCOMP * 2 05820254 ! 586: IF ( LVON02 ) THEN 05830254 ! 587: IVCOMP = IVCOMP * 3 05840254 ! 588: ELSE IF ( LVON03 ) THEN 05850254 ! 589: IVCOMP = IVCOMP * 5 05860254 ! 590: ELSE IF ( LVON04 ) THEN 05870254 ! 591: IVCOMP = IVCOMP * 7 05880254 ! 592: END IF 05890254 ! 593: ELSE IF ( LVON05 ) THEN 05900254 ! 594: IVCOMP = IVCOMP * 11 05910254 ! 595: ELSE IF ( LVON06 ) THEN 05920254 ! 596: IVCOMP = IVCOMP * 13 05930254 ! 597: END IF 05940254 ! 598: C 05950254 ! 599: C **** IVCOMP IS DETERMINED BY IVCOMP = 13 = 1 * 13 ****05960254 ! 600: C 05970254 ! 601: IVCORR = 13 05980254 ! 602: 40120 IF ( IVCOMP - 13 ) 20120, 10120, 20120 05990254 ! 603: 30120 IVDELE = IVDELE + 1 06000254 ! 604: WRITE (I02,80000) IVTNUM 06010254 ! 605: IF (ICZERO) 10120, 0131, 20120 06020254 ! 606: 10120 IVPASS = IVPASS + 1 06030254 ! 607: WRITE (I02,80002) IVTNUM 06040254 ! 608: GO TO 0131 06050254 ! 609: 20120 IVFAIL = IVFAIL + 1 06060254 ! 610: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06070254 ! 611: 0131 CONTINUE 06080254 ! 612: C 06090254 ! 613: C 06100254 ! 614: C WRITE OUT TEST SUMMARY 06110254 ! 615: C 06120254 ! 616: WRITE (I02,90004) 06130254 ! 617: WRITE (I02,90014) 06140254 ! 618: WRITE (I02,90004) 06150254 ! 619: WRITE (I02,90000) 06160254 ! 620: WRITE (I02,90004) 06170254 ! 621: WRITE (I02,90020) IVFAIL 06180254 ! 622: WRITE (I02,90022) IVPASS 06190254 ! 623: WRITE (I02,90024) IVDELE 06200254 ! 624: STOP 06210254 ! 625: 90001 FORMAT (1H ,24X,5HFM254) 06220254 ! 626: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM254) 06230254 ! 627: C 06240254 ! 628: C FORMATS FOR TEST DETAIL LINES 06250254 ! 629: C 06260254 ! 630: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 06270254 ! 631: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 06280254 ! 632: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 06290254 ! 633: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 06300254 ! 634: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 06310254 ! 635: C 06320254 ! 636: C FORMAT STATEMENTS FOR PAGE HEADERS 06330254 ! 637: C 06340254 ! 638: 90002 FORMAT (1H1) 06350254 ! 639: 90004 FORMAT (1H ) 06360254 ! 640: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06370254 ! 641: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 06380254 ! 642: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 06390254 ! 643: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 06400254 ! 644: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 06410254 ! 645: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 06420254 ! 646: C 06430254 ! 647: C FORMAT STATEMENTS FOR RUN SUMMARY 06440254 ! 648: C 06450254 ! 649: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 06460254 ! 650: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 06470254 ! 651: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 06480254 ! 652: END 06490254
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.