|
|
1.1 ! root 1: C 00010019 ! 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 COMMENT SECTION. 00020019 ! 6: C 00030019 ! 7: C FM019 00040019 ! 8: C 00050019 ! 9: C THIS ROUTINE CONTINUES TESTS OF THE FORTRAN LOGICAL IF STATE00060019 ! 10: C BY TESTING VARIOUS FORMS OF RELATIONAL EXPRESSIONS WITH ARITHMETIC00070019 ! 11: C EXPRESSIONS . POSITIVE AND NEGATIVE SIGNS ARE USED IN CONJUNCTION00080019 ! 12: C WITH PARENTHESES. COMBINATIONS OF LOGICAL .AND. .OR. 00090019 ! 13: C .NOT. ARE USED TO TEST THE MORE COMPLEX EXPRESSIONS. 00100019 ! 14: C 00110019 ! 15: C REFERENCES 00120019 ! 16: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130019 ! 17: C X3.9-1978 00140019 ! 18: C 00150019 ! 19: C SECTION 4.7.1, LOGICAL CONSTANT 00160019 ! 20: C SECTION 6, EXPRESSIONS 00170019 ! 21: C SECTION 11.5, LOGICAL IF STATEMENT 00180019 ! 22: C 00190019 ! 23: LOGICAL LCTNT1, LCTNT2 00200019 ! 24: C 00210019 ! 25: C ********************************************************** 00220019 ! 26: C 00230019 ! 27: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00240019 ! 28: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00250019 ! 29: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00260019 ! 30: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00270019 ! 31: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00280019 ! 32: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00290019 ! 33: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00300019 ! 34: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00310019 ! 35: C OF EXECUTING THESE TESTS. 00320019 ! 36: C 00330019 ! 37: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00340019 ! 38: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00350019 ! 39: C 00360019 ! 40: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00370019 ! 41: C 00380019 ! 42: C DEPARTMENT OF THE NAVY 00390019 ! 43: C FEDERAL COBOL COMPILER TESTING SERVICE 00400019 ! 44: C WASHINGTON, D.C. 20376 00410019 ! 45: C 00420019 ! 46: C ********************************************************** 00430019 ! 47: C 00440019 ! 48: C 00450019 ! 49: C 00460019 ! 50: C INITIALIZATION SECTION 00470019 ! 51: C 00480019 ! 52: C INITIALIZE CONSTANTS 00490019 ! 53: C ************** 00500019 ! 54: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00510019 ! 55: I01 = 5 00520019 ! 56: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00530019 ! 57: I02 = 6 00540019 ! 58: C SYSTEM ENVIRONMENT SECTION 00550019 ! 59: C 00560019 ! 60: I01 = 5 00570019 ! 61: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00580019 ! 62: C (UNIT NUMBER FOR CARD READER). 00590019 ! 63: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00600019 ! 64: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00610019 ! 65: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00620019 ! 66: C 00630019 ! 67: I02 = 6 00640019 ! 68: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00650019 ! 69: C (UNIT NUMBER FOR PRINTER). 00660019 ! 70: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00670019 ! 71: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00680019 ! 72: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00690019 ! 73: C 00700019 ! 74: IVPASS=0 00710019 ! 75: IVFAIL=0 00720019 ! 76: IVDELE=0 00730019 ! 77: ICZERO=0 00740019 ! 78: C 00750019 ! 79: C WRITE PAGE HEADERS 00760019 ! 80: WRITE (I02,90000) 00770019 ! 81: WRITE (I02,90001) 00780019 ! 82: WRITE (I02,90002) 00790019 ! 83: WRITE (I02, 90002) 00800019 ! 84: WRITE (I02,90003) 00810019 ! 85: WRITE (I02,90002) 00820019 ! 86: WRITE (I02,90004) 00830019 ! 87: WRITE (I02,90002) 00840019 ! 88: WRITE (I02,90011) 00850019 ! 89: WRITE (I02,90002) 00860019 ! 90: WRITE (I02,90002) 00870019 ! 91: WRITE (I02,90005) 00880019 ! 92: WRITE (I02,90006) 00890019 ! 93: WRITE (I02,90002) 00900019 ! 94: IVTNUM = 530 00910019 ! 95: C 00920019 ! 96: C **** TEST 530 **** 00930019 ! 97: C TEST 530 - TEST OF POSITIVELY SIGNED TERM +(IC) (RO) -(IC) 00940019 ! 98: C .LT. FALSE PATH 00950019 ! 99: C 00960019 ! 100: IF (ICZERO) 35300, 5300, 35300 00970019 ! 101: 5300 CONTINUE 00980019 ! 102: IVON01 = 1 00990019 ! 103: IF ( +3 .LT. -3) IVON01 = 0 01000019 ! 104: GO TO 45300 01010019 ! 105: 35300 IVDELE = IVDELE + 1 01020019 ! 106: WRITE (I02,80003) IVTNUM 01030019 ! 107: IF (ICZERO) 45300, 5311, 45300 01040019 ! 108: 45300 IF ( IVON01 - 1 ) 25300, 15300, 25300 01050019 ! 109: 15300 IVPASS = IVPASS + 1 01060019 ! 110: WRITE (I02,80001) IVTNUM 01070019 ! 111: GO TO 5311 01080019 ! 112: 25300 IVFAIL = IVFAIL + 1 01090019 ! 113: IVCOMP = IVON01 01100019 ! 114: IVCORR = 1 01110019 ! 115: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01120019 ! 116: 5311 CONTINUE 01130019 ! 117: IVTNUM = 531 01140019 ! 118: C 01150019 ! 119: C **** TEST 531 **** 01160019 ! 120: C TEST 531 - TEST OF SIGNED ZERO .LT. FALSE PATH 01170019 ! 121: C 01180019 ! 122: C 01190019 ! 123: IF (ICZERO) 35310, 5310, 35310 01200019 ! 124: 5310 CONTINUE 01210019 ! 125: IVON01 = 1 01220019 ! 126: IF ( +0 .LT. -0 ) IVON01 = 0 01230019 ! 127: GO TO 45310 01240019 ! 128: 35310 IVDELE = IVDELE + 1 01250019 ! 129: WRITE (I02,80003) IVTNUM 01260019 ! 130: IF (ICZERO) 45310, 5321, 45310 01270019 ! 131: 45310 IF ( IVON01 - 1 ) 25310, 15310, 25310 01280019 ! 132: 15310 IVPASS = IVPASS + 1 01290019 ! 133: WRITE (I02,80001) IVTNUM 01300019 ! 134: GO TO 5321 01310019 ! 135: 25310 IVFAIL = IVFAIL + 1 01320019 ! 136: IVCOMP = IVON01 01330019 ! 137: IVCORR = 1 01340019 ! 138: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01350019 ! 139: 5321 CONTINUE 01360019 ! 140: IVTNUM = 532 01370019 ! 141: C 01380019 ! 142: C **** TEST 532 **** 01390019 ! 143: C TEST 532 - TEST OF SIGNED ZERO .LE. TRUE PATH 01400019 ! 144: C 01410019 ! 145: C 01420019 ! 146: IF (ICZERO) 35320, 5320, 35320 01430019 ! 147: 5320 CONTINUE 01440019 ! 148: IVON01 = 0 01450019 ! 149: IF ( +0 .LE. -0 ) IVON01 = 1 01460019 ! 150: GO TO 45320 01470019 ! 151: 35320 IVDELE = IVDELE + 1 01480019 ! 152: WRITE (I02,80003) IVTNUM 01490019 ! 153: IF (ICZERO) 45320, 5331, 45320 01500019 ! 154: 45320 IF ( IVON01 - 1 ) 25320, 15320, 25320 01510019 ! 155: 15320 IVPASS = IVPASS + 1 01520019 ! 156: WRITE (I02,80001) IVTNUM 01530019 ! 157: GO TO 5331 01540019 ! 158: 25320 IVFAIL = IVFAIL + 1 01550019 ! 159: IVCOMP = IVON01 01560019 ! 160: IVCORR = 1 01570019 ! 161: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01580019 ! 162: 5331 CONTINUE 01590019 ! 163: IVTNUM = 533 01600019 ! 164: C 01610019 ! 165: C **** TEST 533 **** 01620019 ! 166: C TEST 533 - TEST OF SIGNED ZERO .EQ. TRUE PATH 01630019 ! 167: C 01640019 ! 168: C 01650019 ! 169: IF (ICZERO) 35330, 5330, 35330 01660019 ! 170: 5330 CONTINUE 01670019 ! 171: IVON01 = 0 01680019 ! 172: IF ( +0 .EQ. -0 ) IVON01 = 1 01690019 ! 173: GO TO 45330 01700019 ! 174: 35330 IVDELE = IVDELE + 1 01710019 ! 175: WRITE (I02,80003) IVTNUM 01720019 ! 176: IF (ICZERO) 45330, 5341, 45330 01730019 ! 177: 45330 IF ( IVON01 - 1 ) 25330, 15330, 25330 01740019 ! 178: 15330 IVPASS = IVPASS + 1 01750019 ! 179: WRITE (I02,80001) IVTNUM 01760019 ! 180: GO TO 5341 01770019 ! 181: 25330 IVFAIL = IVFAIL + 1 01780019 ! 182: IVCOMP = IVON01 01790019 ! 183: IVCORR = 1 01800019 ! 184: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01810019 ! 185: 5341 CONTINUE 01820019 ! 186: IVTNUM = 534 01830019 ! 187: C 01840019 ! 188: C **** TEST 534 **** 01850019 ! 189: C TEST 534 - TEST OF SIGNED ZERO .NE. FALSE PATH 01860019 ! 190: C 01870019 ! 191: C 01880019 ! 192: IF (ICZERO) 35340, 5340, 35340 01890019 ! 193: 5340 CONTINUE 01900019 ! 194: IVON01 = 1 01910019 ! 195: IF ( +0 .NE. -0 ) IVON01 = 0 01920019 ! 196: GO TO 45340 01930019 ! 197: 35340 IVDELE = IVDELE + 1 01940019 ! 198: WRITE (I02,80003) IVTNUM 01950019 ! 199: IF (ICZERO) 45340, 5351, 45340 01960019 ! 200: 45340 IF ( IVON01 - 1 ) 25340, 15340, 25340 01970019 ! 201: 15340 IVPASS = IVPASS + 1 01980019 ! 202: WRITE (I02,80001) IVTNUM 01990019 ! 203: GO TO 5351 02000019 ! 204: 25340 IVFAIL = IVFAIL + 1 02010019 ! 205: IVCOMP = IVON01 02020019 ! 206: IVCORR = 1 02030019 ! 207: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02040019 ! 208: 5351 CONTINUE 02050019 ! 209: IVTNUM = 535 02060019 ! 210: C 02070019 ! 211: C **** TEST 535 **** 02080019 ! 212: C TEST 535 - TEST OF SIGNED ZERO .GE. TRUE PATH 02090019 ! 213: C 02100019 ! 214: C 02110019 ! 215: IF (ICZERO) 35350, 5350, 35350 02120019 ! 216: 5350 CONTINUE 02130019 ! 217: IVON01 = 0 02140019 ! 218: IF ( +0 .GE. -0 ) IVON01 = 1 02150019 ! 219: GO TO 45350 02160019 ! 220: 35350 IVDELE = IVDELE + 1 02170019 ! 221: WRITE (I02,80003) IVTNUM 02180019 ! 222: IF (ICZERO) 45350, 5361, 45350 02190019 ! 223: 45350 IF ( IVON01 - 1 ) 25350, 15350, 25350 02200019 ! 224: 15350 IVPASS = IVPASS + 1 02210019 ! 225: WRITE (I02,80001) IVTNUM 02220019 ! 226: GO TO 5361 02230019 ! 227: 25350 IVFAIL = IVFAIL + 1 02240019 ! 228: IVCOMP = IVON01 02250019 ! 229: IVCORR = 1 02260019 ! 230: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02270019 ! 231: 5361 CONTINUE 02280019 ! 232: IVTNUM = 536 02290019 ! 233: C 02300019 ! 234: C **** TEST 536 **** 02310019 ! 235: C TEST 536 - TEST OF SIGNED ZERO .GT. FALSE PATH 02320019 ! 236: C 02330019 ! 237: C 02340019 ! 238: IF (ICZERO) 35360, 5360, 35360 02350019 ! 239: 5360 CONTINUE 02360019 ! 240: IVON01 = 1 02370019 ! 241: IF ( +0 .GT. -0 ) IVON01 = 0 02380019 ! 242: GO TO 45360 02390019 ! 243: 35360 IVDELE = IVDELE + 1 02400019 ! 244: WRITE (I02,80003) IVTNUM 02410019 ! 245: IF (ICZERO) 45360, 5371, 45360 02420019 ! 246: 45360 IF ( IVON01 - 1 ) 25360, 15360, 25360 02430019 ! 247: 15360 IVPASS = IVPASS + 1 02440019 ! 248: WRITE (I02,80001) IVTNUM 02450019 ! 249: GO TO 5371 02460019 ! 250: 25360 IVFAIL = IVFAIL + 1 02470019 ! 251: IVCOMP = IVON01 02480019 ! 252: IVCORR = 1 02490019 ! 253: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02500019 ! 254: 5371 CONTINUE 02510019 ! 255: IVTNUM = 537 02520019 ! 256: C 02530019 ! 257: C **** TEST 537 **** 02540019 ! 258: C TEST 537 - TEST OF +32767 .EQ. -32766 FALSE PATH 02550019 ! 259: C 02560019 ! 260: C 02570019 ! 261: IF (ICZERO) 35370, 5370, 35370 02580019 ! 262: 5370 CONTINUE 02590019 ! 263: IVON01 = 1 02600019 ! 264: IF ( +32767 .EQ. -32766 ) IVON01 = 0 02610019 ! 265: GO TO 45370 02620019 ! 266: 35370 IVDELE = IVDELE + 1 02630019 ! 267: WRITE (I02,80003) IVTNUM 02640019 ! 268: IF (ICZERO) 45370, 5381, 45370 02650019 ! 269: 45370 IF ( IVON01 - 1 ) 25370, 15370, 25370 02660019 ! 270: 15370 IVPASS = IVPASS + 1 02670019 ! 271: WRITE (I02,80001) IVTNUM 02680019 ! 272: GO TO 5381 02690019 ! 273: 25370 IVFAIL = IVFAIL + 1 02700019 ! 274: IVCOMP = IVON01 02710019 ! 275: IVCORR = 1 02720019 ! 276: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02730019 ! 277: 5381 CONTINUE 02740019 ! 278: IVTNUM = 538 02750019 ! 279: C 02760019 ! 280: C **** TEST 538 **** 02770019 ! 281: C TEST 538 - TESTS MINUS SIGN WITH INTEGER VARIABLES 02780019 ! 282: C RELATIONAL EXPRESSION USES .LE. TRUE PATH 02790019 ! 283: C 02800019 ! 284: C 02810019 ! 285: IF (ICZERO) 35380, 5380, 35380 02820019 ! 286: 5380 CONTINUE 02830019 ! 287: IVON01 = 0 02840019 ! 288: IVON02 = 3 02850019 ! 289: IF ( -IVON02 .LE. -IVON02 ) IVON01 = 1 02860019 ! 290: GO TO 45380 02870019 ! 291: 35380 IVDELE = IVDELE + 1 02880019 ! 292: WRITE (I02,80003) IVTNUM 02890019 ! 293: IF (ICZERO) 45380, 5391, 45380 02900019 ! 294: 45380 IF ( IVON01 - 1 ) 25380, 15380, 25380 02910019 ! 295: 15380 IVPASS = IVPASS + 1 02920019 ! 296: WRITE (I02,80001) IVTNUM 02930019 ! 297: GO TO 5391 02940019 ! 298: 25380 IVFAIL = IVFAIL + 1 02950019 ! 299: IVCOMP = IVON01 02960019 ! 300: IVCORR = 1 02970019 ! 301: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02980019 ! 302: 5391 CONTINUE 02990019 ! 303: IVTNUM = 539 03000019 ! 304: C 03010019 ! 305: C **** TEST 539 **** 03020019 ! 306: C TEST 539 - TEST IS LIKE TEST 538 USES .GE. TRUE PATH 03030019 ! 307: C 03040019 ! 308: C 03050019 ! 309: IF (ICZERO) 35390, 5390, 35390 03060019 ! 310: 5390 CONTINUE 03070019 ! 311: IVON01 = 0 03080019 ! 312: IVON02 = 32766 03090019 ! 313: IF ( -IVON02 .GE. -IVON02 ) IVON01 = 1 03100019 ! 314: GO TO 45390 03110019 ! 315: 35390 IVDELE = IVDELE + 1 03120019 ! 316: WRITE (I02,80003) IVTNUM 03130019 ! 317: IF (ICZERO) 45390, 5401, 45390 03140019 ! 318: 45390 IF ( IVON01 - 1 ) 25390, 15390, 25390 03150019 ! 319: 15390 IVPASS = IVPASS + 1 03160019 ! 320: WRITE (I02,80001) IVTNUM 03170019 ! 321: GO TO 5401 03180019 ! 322: 25390 IVFAIL = IVFAIL + 1 03190019 ! 323: IVCOMP = IVON01 03200019 ! 324: IVCORR = 1 03210019 ! 325: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03220019 ! 326: 5401 CONTINUE 03230019 ! 327: IVTNUM = 540 03240019 ! 328: C 03250019 ! 329: C **** TEST 540 **** 03260019 ! 330: C TEST 540 - INTEGER EXPONIENTIATION AND MINUS SIGN USES .NE. 03270019 ! 331: C FALSE PATH 03280019 ! 332: C 03290019 ! 333: C 03300019 ! 334: IF (ICZERO) 35400, 5400, 35400 03310019 ! 335: 5400 CONTINUE 03320019 ! 336: IVON01 = 1 03330019 ! 337: IVON02 = 3 03340019 ! 338: IF ( -IVON02 ** 3 .NE. -27 ) IVON01 = 0 03350019 ! 339: GO TO 45400 03360019 ! 340: 35400 IVDELE = IVDELE + 1 03370019 ! 341: WRITE (I02,80003) IVTNUM 03380019 ! 342: IF (ICZERO) 45400, 5411, 45400 03390019 ! 343: 45400 IF ( IVON01 - 1 ) 25400, 15400, 25400 03400019 ! 344: 15400 IVPASS = IVPASS + 1 03410019 ! 345: WRITE (I02,80001) IVTNUM 03420019 ! 346: GO TO 5411 03430019 ! 347: 25400 IVFAIL = IVFAIL + 1 03440019 ! 348: IVCOMP = IVON01 03450019 ! 349: IVCORR = 1 03460019 ! 350: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03470019 ! 351: 5411 CONTINUE 03480019 ! 352: IVTNUM = 541 03490019 ! 353: C 03500019 ! 354: C **** TEST 541 **** 03510019 ! 355: C TEST 541 - LIKE TEST 540 USES .LE. TRUE PATH 03520019 ! 356: C 03530019 ! 357: C 03540019 ! 358: IF (ICZERO) 35410, 5410, 35410 03550019 ! 359: 5410 CONTINUE 03560019 ! 360: IVON01 = 0 03570019 ! 361: IVON02 = 3 03580019 ! 362: IF ( -3 ** IVON02 .LE. -27 ) IVON01 = 1 03590019 ! 363: GO TO 45410 03600019 ! 364: 35410 IVDELE = IVDELE + 1 03610019 ! 365: WRITE (I02,80003) IVTNUM 03620019 ! 366: IF (ICZERO) 45410, 5421, 45410 03630019 ! 367: 45410 IF ( IVON01 - 1 ) 25410, 15410, 25410 03640019 ! 368: 15410 IVPASS = IVPASS + 1 03650019 ! 369: WRITE (I02,80001) IVTNUM 03660019 ! 370: GO TO 5421 03670019 ! 371: 25410 IVFAIL = IVFAIL + 1 03680019 ! 372: IVCOMP = IVON01 03690019 ! 373: IVCORR = 1 03700019 ! 374: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03710019 ! 375: 5421 CONTINUE 03720019 ! 376: IVTNUM = 542 03730019 ! 377: C 03740019 ! 378: C **** TEST 542 **** 03750019 ! 379: C TEST 542 - INTEGER EXPONIENTIATION AND MULTIPLICATION 03760019 ! 380: C USES .EQ. TRUE PATH 03770019 ! 381: C 03780019 ! 382: C 03790019 ! 383: IF (ICZERO) 35420, 5420, 35420 03800019 ! 384: 5420 CONTINUE 03810019 ! 385: IVON01 = 0 03820019 ! 386: IVON02 = 3 03830019 ! 387: IVON03 = 27 03840019 ! 388: IF ( -IVON02 ** 2 * IVON02 .EQ. -IVON03 ) IVON01 = 1 03850019 ! 389: GO TO 45420 03860019 ! 390: 35420 IVDELE = IVDELE + 1 03870019 ! 391: WRITE (I02,80003) IVTNUM 03880019 ! 392: IF (ICZERO) 45420, 5431, 45420 03890019 ! 393: 45420 IF ( IVON01 - 1 ) 25420, 15420, 25420 03900019 ! 394: 15420 IVPASS = IVPASS + 1 03910019 ! 395: WRITE (I02,80001) IVTNUM 03920019 ! 396: GO TO 5431 03930019 ! 397: 25420 IVFAIL = IVFAIL + 1 03940019 ! 398: IVCOMP = IVON01 03950019 ! 399: IVCORR = 1 03960019 ! 400: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03970019 ! 401: 5431 CONTINUE 03980019 ! 402: IVTNUM = 543 03990019 ! 403: C 04000019 ! 404: C **** TEST 543 **** 04010019 ! 405: C TEST 543 - INTEGER EXPONIENTIATION AND DIVISION 04020019 ! 406: C USES .LT. TRUE PATH 04030019 ! 407: C 04040019 ! 408: C 04050019 ! 409: IF (ICZERO) 35430, 5430, 35430 04060019 ! 410: 5430 CONTINUE 04070019 ! 411: IVON01 = 0 04080019 ! 412: IVON02 = 587 04090019 ! 413: IVON03 = 3 04100019 ! 414: IVON04 = 3 04110019 ! 415: IF ( -IVON02/IVON04 ** 3 .LT. -3 ** IVON03/IVON02 ) IVON01 = 1 04120019 ! 416: GO TO 45430 04130019 ! 417: 35430 IVDELE = IVDELE + 1 04140019 ! 418: WRITE (I02,80003) IVTNUM 04150019 ! 419: IF (ICZERO) 45430, 5441, 45430 04160019 ! 420: 45430 IF ( IVON01 - 1 ) 25430, 15430, 25430 04170019 ! 421: 15430 IVPASS = IVPASS + 1 04180019 ! 422: WRITE (I02,80001) IVTNUM 04190019 ! 423: GO TO 5441 04200019 ! 424: 25430 IVFAIL = IVFAIL + 1 04210019 ! 425: IVCOMP = IVON01 04220019 ! 426: IVCORR = 1 04230019 ! 427: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04240019 ! 428: 5441 CONTINUE 04250019 ! 429: IVTNUM = 544 04260019 ! 430: C 04270019 ! 431: C **** TEST 544 **** 04280019 ! 432: C TEST 544 - INTEGER ADDITION AND SUBTRACTION 04290019 ! 433: C USES .EQ. TRUE PATH 04300019 ! 434: C 04310019 ! 435: C 04320019 ! 436: IF (ICZERO) 35440, 5440, 35440 04330019 ! 437: 5440 CONTINUE 04340019 ! 438: IVON01 = 0 04350019 ! 439: IVON02 = 3 04360019 ! 440: IVON03 = 587 04370019 ! 441: IF ( IVON02 - IVON03 .EQ. -IVON03 + IVON02 ) IVON01 = 1 04380019 ! 442: GO TO 45440 04390019 ! 443: 35440 IVDELE = IVDELE + 1 04400019 ! 444: WRITE (I02,80003) IVTNUM 04410019 ! 445: IF (ICZERO) 45440, 5451, 45440 04420019 ! 446: 45440 IF ( IVON01 - 1 ) 25440, 15440, 25440 04430019 ! 447: 15440 IVPASS = IVPASS + 1 04440019 ! 448: WRITE (I02,80001) IVTNUM 04450019 ! 449: GO TO 5451 04460019 ! 450: 25440 IVFAIL = IVFAIL + 1 04470019 ! 451: IVCOMP = IVON01 04480019 ! 452: IVCORR = 1 04490019 ! 453: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04500019 ! 454: 5451 CONTINUE 04510019 ! 455: IVTNUM = 545 04520019 ! 456: C 04530019 ! 457: C **** TEST 545 **** 04540019 ! 458: C TEST 545 - INTEGER ADDITION AND SUBTRACTION WITH PARENTHESES 04550019 ! 459: C USES .EQ. TRUE PATH LIKE TEST 544 04560019 ! 460: C 04570019 ! 461: C 04580019 ! 462: IF (ICZERO) 35450, 5450, 35450 04590019 ! 463: 5450 CONTINUE 04600019 ! 464: IVON01 = 0 04610019 ! 465: IVON02 = 3 04620019 ! 466: IVON03 = 587 04630019 ! 467: IF ( (IVON02 - IVON03) .EQ. (-IVON03 + IVON02) ) IVON01 = 1 04640019 ! 468: GO TO 45450 04650019 ! 469: 35450 IVDELE = IVDELE + 1 04660019 ! 470: WRITE (I02,80003) IVTNUM 04670019 ! 471: IF (ICZERO) 45450, 5461, 45450 04680019 ! 472: 45450 IF ( IVON01 - 1 ) 25450, 15450, 25450 04690019 ! 473: 15450 IVPASS = IVPASS + 1 04700019 ! 474: WRITE (I02,80001) IVTNUM 04710019 ! 475: GO TO 5461 04720019 ! 476: 25450 IVFAIL = IVFAIL + 1 04730019 ! 477: IVCOMP = IVON01 04740019 ! 478: IVCORR = 1 04750019 ! 479: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04760019 ! 480: 5461 CONTINUE 04770019 ! 481: IVTNUM = 546 04780019 ! 482: C 04790019 ! 483: C **** TEST 546 **** 04800019 ! 484: C TEST 546 - INTEGER EXPONIENTIATION AND DIVISION WITH PARENS 04810019 ! 485: C USES .LT. TRUE PATH 04820019 ! 486: C 04830019 ! 487: C 04840019 ! 488: IF (ICZERO) 35460, 5460, 35460 04850019 ! 489: 5460 CONTINUE 04860019 ! 490: IVON01 = 0 04870019 ! 491: IVON02 = 587 04880019 ! 492: IVON03 = 3 04890019 ! 493: IVON04 = 3 04900019 ! 494: IF ((-IVON02/(IVON04**3)).LT.((-3**IVON03)/IVON02))IVON01=1 04910019 ! 495: GO TO 45460 04920019 ! 496: 35460 IVDELE = IVDELE + 1 04930019 ! 497: WRITE (I02,80003) IVTNUM 04940019 ! 498: IF (ICZERO) 45460, 5471, 45460 04950019 ! 499: 45460 IF ( IVON01 - 1 ) 25460, 15460, 25460 04960019 ! 500: 15460 IVPASS = IVPASS + 1 04970019 ! 501: WRITE (I02,80001) IVTNUM 04980019 ! 502: GO TO 5471 04990019 ! 503: 25460 IVFAIL = IVFAIL + 1 05000019 ! 504: IVCOMP = IVON01 05010019 ! 505: IVCORR = 1 05020019 ! 506: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05030019 ! 507: 5471 CONTINUE 05040019 ! 508: IVTNUM = 547 05050019 ! 509: C 05060019 ! 510: C **** TEST 547 **** 05070019 ! 511: C TEST 547 - INTEGER MULTIPLICATION WITH PARENTHESES .LT. FALSE 05080019 ! 512: C 05090019 ! 513: C 05100019 ! 514: IF (ICZERO) 35470, 5470, 35470 05110019 ! 515: 5470 CONTINUE 05120019 ! 516: IVON01 = 1 05130019 ! 517: IVON02 = 587 05140019 ! 518: IF ((-3)*(-3).LT.(-IVON02))IVON01=0 05150019 ! 519: GO TO 45470 05160019 ! 520: 35470 IVDELE = IVDELE + 1 05170019 ! 521: WRITE (I02,80003) IVTNUM 05180019 ! 522: IF (ICZERO) 45470, 5481, 45470 05190019 ! 523: 45470 IF ( IVON01 - 1 ) 25470, 15470, 25470 05200019 ! 524: 15470 IVPASS = IVPASS + 1 05210019 ! 525: WRITE (I02,80001) IVTNUM 05220019 ! 526: GO TO 5481 05230019 ! 527: 25470 IVFAIL = IVFAIL + 1 05240019 ! 528: IVCOMP = IVON01 05250019 ! 529: IVCORR = 1 05260019 ! 530: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05270019 ! 531: 5481 CONTINUE 05280019 ! 532: IVTNUM = 548 05290019 ! 533: C 05300019 ! 534: C **** TEST 548 **** 05310019 ! 535: C TEST 548 - INTEGER EXPONIENTIATION, MINUS SIGNS, AND PARENTHESES05320019 ! 536: C USES .LE. TRUE PATH 05330019 ! 537: C 05340019 ! 538: C 05350019 ! 539: IF (ICZERO) 35480, 5480, 35480 05360019 ! 540: 5480 CONTINUE 05370019 ! 541: IVON01 = 0 05380019 ! 542: IVON02 = 3 05390019 ! 543: IVON03 = 27 05400019 ! 544: IF ( ((-IVON02) ** IVON02 .LE. (-IVON03))) IVON01 = 1 05410019 ! 545: GO TO 45480 05420019 ! 546: 35480 IVDELE = IVDELE + 1 05430019 ! 547: WRITE (I02,80003) IVTNUM 05440019 ! 548: IF (ICZERO) 45480, 5491, 45480 05450019 ! 549: 45480 IF ( IVON01 - 1 ) 25480, 15480, 25480 05460019 ! 550: 15480 IVPASS = IVPASS + 1 05470019 ! 551: WRITE (I02,80001) IVTNUM 05480019 ! 552: GO TO 5491 05490019 ! 553: 25480 IVFAIL = IVFAIL + 1 05500019 ! 554: IVCOMP = IVON01 05510019 ! 555: IVCORR = 1 05520019 ! 556: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05530019 ! 557: 5491 CONTINUE 05540019 ! 558: IVTNUM = 549 05550019 ! 559: C 05560019 ! 560: C **** TEST 549 **** 05570019 ! 561: C TEST 549 - TEST THE ORDER OF INTEGER ARITHMETIC OPERATIONS 05580019 ! 562: C USES INTEGER EXPONIENTIATION, ADDITION, MULTIPLICATION, 05590019 ! 563: C AND PARENTHESES. ALSO USES .EQ. TRUE PATH 05600019 ! 564: C SEE SECTION 6.1, ARITHMETIC EXPRESSIONS. 05610019 ! 565: C 05620019 ! 566: C 05630019 ! 567: IF (ICZERO) 35490, 5490, 35490 05640019 ! 568: 5490 CONTINUE 05650019 ! 569: IVON01 = 0 05660019 ! 570: IVON02 = 3 05670019 ! 571: IF(IVON02 * IVON02/(IVON02+IVON02)**IVON02+IVON02 .EQ. 3) IVON01=105680019 ! 572: GO TO 45490 05690019 ! 573: 35490 IVDELE = IVDELE + 1 05700019 ! 574: WRITE (I02,80003) IVTNUM 05710019 ! 575: IF (ICZERO) 45490, 5501, 45490 05720019 ! 576: 45490 IF ( IVON01 - 1 ) 25490, 15490, 25490 05730019 ! 577: 15490 IVPASS = IVPASS + 1 05740019 ! 578: WRITE (I02,80001) IVTNUM 05750019 ! 579: GO TO 5501 05760019 ! 580: 25490 IVFAIL = IVFAIL + 1 05770019 ! 581: IVCOMP = IVON01 05780019 ! 582: IVCORR = 1 05790019 ! 583: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05800019 ! 584: 5501 CONTINUE 05810019 ! 585: IVTNUM = 550 05820019 ! 586: C 05830019 ! 587: C **** TEST 550 **** 05840019 ! 588: C TEST 550 - COMBINATION OF LOGICAL .NOT. AND .AND. 05850019 ! 589: C .NOT. (LP) .AND. .NOT. (LP) 05860019 ! 590: C TRUE PATH 05870019 ! 591: C 05880019 ! 592: C 05890019 ! 593: IF (ICZERO) 35500, 5500, 35500 05900019 ! 594: 5500 CONTINUE 05910019 ! 595: IVON01 = 0 05920019 ! 596: LCTNT1 = .FALSE. 05930019 ! 597: IF ( .NOT. .FALSE. .AND. .NOT. LCTNT1 ) IVON01 = 1 05940019 ! 598: GO TO 45500 05950019 ! 599: 35500 IVDELE = IVDELE + 1 05960019 ! 600: WRITE (I02,80003) IVTNUM 05970019 ! 601: IF (ICZERO) 45500, 5511, 45500 05980019 ! 602: 45500 IF ( IVON01 - 1 ) 25500, 15500, 25500 05990019 ! 603: 15500 IVPASS = IVPASS + 1 06000019 ! 604: WRITE (I02,80001) IVTNUM 06010019 ! 605: GO TO 5511 06020019 ! 606: 25500 IVFAIL = IVFAIL + 1 06030019 ! 607: IVCOMP = IVON01 06040019 ! 608: IVCORR = 1 06050019 ! 609: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06060019 ! 610: 5511 CONTINUE 06070019 ! 611: IVTNUM = 551 06080019 ! 612: C 06090019 ! 613: C **** TEST 551 **** 06100019 ! 614: C TEST 551 - COMBINATION OF LOGICAL .OR. AND .NOT. 06110019 ! 615: C .NOT. (LP) .OR. .NOT. (LP) 06120019 ! 616: C TRUE PATH 06130019 ! 617: C 06140019 ! 618: C 06150019 ! 619: IF (ICZERO) 35510, 5510, 35510 06160019 ! 620: 5510 CONTINUE 06170019 ! 621: IVON01 = 0 06180019 ! 622: LCTNT1 = .TRUE. 06190019 ! 623: LCTNT2 = .FALSE. 06200019 ! 624: IF ( .NOT. LCTNT1 .OR. .NOT. LCTNT2 ) IVON01 = 1 06210019 ! 625: GO TO 45510 06220019 ! 626: 35510 IVDELE = IVDELE + 1 06230019 ! 627: WRITE (I02,80003) IVTNUM 06240019 ! 628: IF (ICZERO) 45510, 5521, 45510 06250019 ! 629: 45510 IF ( IVON01 - 1 ) 25510, 15510, 25510 06260019 ! 630: 15510 IVPASS = IVPASS + 1 06270019 ! 631: WRITE (I02,80001) IVTNUM 06280019 ! 632: GO TO 5521 06290019 ! 633: 25510 IVFAIL = IVFAIL + 1 06300019 ! 634: IVCOMP = IVON01 06310019 ! 635: IVCORR = 1 06320019 ! 636: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06330019 ! 637: 5521 CONTINUE 06340019 ! 638: IVTNUM = 552 06350019 ! 639: C 06360019 ! 640: C **** TEST 552 **** 06370019 ! 641: C TEST 552 - COMBINATION OF LOGICAL .AND. .OR. AND .NOT. 06380019 ! 642: C .NOT. ( (LE) .OR. (LT) ) .AND. .NOT. ( (LT) .AND. (LF) ) 06390019 ! 643: C .NOT. IS APPLIED TO A LOGICAL EXPRESSION INCLOSED IN PARENS 06400019 ! 644: C FALSE PATH 06410019 ! 645: C 06420019 ! 646: IF (ICZERO) 35520, 5520, 35520 06430019 ! 647: 5520 CONTINUE 06440019 ! 648: IVON01 = 1 06450019 ! 649: LCTNT1 = .FALSE. 06460019 ! 650: LCTNT2 = .TRUE. 06470019 ! 651: IF(.NOT.(LCTNT1.OR.LCTNT2).AND..NOT.(LCTNT1.AND.LCTNT2))IVON01 = 006480019 ! 652: GO TO 45520 06490019 ! 653: 35520 IVDELE = IVDELE + 1 06500019 ! 654: WRITE (I02,80003) IVTNUM 06510019 ! 655: IF (ICZERO) 45520, 5531, 45520 06520019 ! 656: 45520 IF ( IVON01 - 1 ) 25520, 15520, 25520 06530019 ! 657: 15520 IVPASS = IVPASS + 1 06540019 ! 658: WRITE (I02,80001) IVTNUM 06550019 ! 659: GO TO 5531 06560019 ! 660: 25520 IVFAIL = IVFAIL + 1 06570019 ! 661: IVCOMP = IVON01 06580019 ! 662: IVCORR = 1 06590019 ! 663: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06600019 ! 664: 5531 CONTINUE 06610019 ! 665: C 06620019 ! 666: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 06630019 ! 667: 99999 CONTINUE 06640019 ! 668: WRITE (I02,90002) 06650019 ! 669: WRITE (I02,90006) 06660019 ! 670: WRITE (I02,90002) 06670019 ! 671: WRITE (I02,90002) 06680019 ! 672: WRITE (I02,90007) 06690019 ! 673: WRITE (I02,90002) 06700019 ! 674: WRITE (I02,90008) IVFAIL 06710019 ! 675: WRITE (I02,90009) IVPASS 06720019 ! 676: WRITE (I02,90010) IVDELE 06730019 ! 677: C 06740019 ! 678: C 06750019 ! 679: C TERMINATE ROUTINE EXECUTION 06760019 ! 680: STOP 06770019 ! 681: C 06780019 ! 682: C FORMAT STATEMENTS FOR PAGE HEADERS 06790019 ! 683: 90000 FORMAT (1H1) 06800019 ! 684: 90002 FORMAT (1H ) 06810019 ! 685: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06820019 ! 686: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 06830019 ! 687: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 06840019 ! 688: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 06850019 ! 689: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 06860019 ! 690: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 06870019 ! 691: C 06880019 ! 692: C FORMAT STATEMENTS FOR RUN SUMMARIES 06890019 ! 693: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 06900019 ! 694: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 06910019 ! 695: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 06920019 ! 696: C 06930019 ! 697: C FORMAT STATEMENTS FOR TEST RESULTS 06940019 ! 698: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 06950019 ! 699: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 06960019 ! 700: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 06970019 ! 701: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 06980019 ! 702: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 06990019 ! 703: C 07000019 ! 704: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM019) 07010019 ! 705: END 07020019
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.