|
|
1.1 ! root 1: C COMMENT SECTION. 00010011 ! 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 00020011 ! 6: C FM011 00030011 ! 7: C 00040011 ! 8: C THIS ROUTINE IS A TEST OF BLANK CHARACTERS (SECTION 3.1.6) 00050011 ! 9: C WHICH SHOULD HAVE NO MEANING WHEN EMBEDDED IN FORTRAN RESERVED00060011 ! 10: C WORDS. 00070011 ! 11: C REFERENCES 00080011 ! 12: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00090011 ! 13: C X3.9-1978 00100011 ! 14: C 00110011 ! 15: C SECTION 3.1.6, BLANK CHARACTER 00120011 ! 16: DIM EN SION IADN11(3),IADN12(3) 00130011 ! 17: IN TEGER RVTNI1 00140011 ! 18: REA L IVTNR1 00150011 ! 19: LOG ICAL LVTNL1,LVTNL2 00160011 ! 20: COM MON IACE11(3) 00170011 ! 21: EQU IVAL ENCE (IACE11(1),IADN11(1)) 00180011 ! 22: D A T A IADN12/3*3/ 00190011 ! 23: C 00200011 ! 24: C ********************************************************** 00210011 ! 25: C 00220011 ! 26: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00230011 ! 27: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00240011 ! 28: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250011 ! 29: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00260011 ! 30: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270011 ! 31: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00280011 ! 32: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00290011 ! 33: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300011 ! 34: C OF EXECUTING THESE TESTS. 00310011 ! 35: C 00320011 ! 36: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330011 ! 37: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00340011 ! 38: C 00350011 ! 39: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00360011 ! 40: C 00370011 ! 41: C DEPARTMENT OF THE NAVY 00380011 ! 42: C FEDERAL COBOL COMPILER TESTING SERVICE 00390011 ! 43: C WASHINGTON, D.C. 20376 00400011 ! 44: C 00410011 ! 45: C ********************************************************** 00420011 ! 46: C 00430011 ! 47: C 00440011 ! 48: C 00450011 ! 49: C INITIALIZATION SECTION 00460011 ! 50: C 00470011 ! 51: C INITIALIZE CONSTANTS 00480011 ! 52: C ************** 00490011 ! 53: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00500011 ! 54: I01 = 5 00510011 ! 55: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00520011 ! 56: I02 = 6 00530011 ! 57: C SYSTEM ENVIRONMENT SECTION 00540011 ! 58: C 00550011 ! 59: I01 = 5 00560011 ! 60: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00570011 ! 61: C (UNIT NUMBER FOR CARD READER). 00580011 ! 62: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590011 ! 63: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00600011 ! 64: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00610011 ! 65: C 00620011 ! 66: I02 = 6 00630011 ! 67: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00640011 ! 68: C (UNIT NUMBER FOR PRINTER). 00650011 ! 69: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660011 ! 70: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670011 ! 71: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00680011 ! 72: C 00690011 ! 73: IVPASS=0 00700011 ! 74: IVFAIL=0 00710011 ! 75: IVDELE=0 00720011 ! 76: ICZERO=0 00730011 ! 77: C 00740011 ! 78: C WRITE PAGE HEADERS 00750011 ! 79: WRITE (I02,90000) 00760011 ! 80: WRITE (I02,90001) 00770011 ! 81: WRITE (I02,90002) 00780011 ! 82: WRITE (I02, 90002) 00790011 ! 83: WRITE (I02,90003) 00800011 ! 84: WRITE (I02,90002) 00810011 ! 85: WRITE (I02,90004) 00820011 ! 86: WRITE (I02,90002) 00830011 ! 87: WRITE (I02,90011) 00840011 ! 88: WRITE (I02,90002) 00850011 ! 89: WRITE (I02,90002) 00860011 ! 90: WRITE (I02,90005) 00870011 ! 91: WRITE (I02,90006) 00880011 ! 92: WRITE (I02,90002) 00890011 ! 93: IVTNUM = 103 00900011 ! 94: C 00910011 ! 95: C **** TEST 103 **** 00920011 ! 96: C TEST 103 - THIS TEST HAS BLANKS EMBEDDED IN A DIMENSION 00930011 ! 97: C STATEMENT. ALSO THE DO STATEMENT WITH AN EMBEDDED BLANK 00940011 ! 98: C WILL BE TESTED TO INITIALIZE VALUES IN AN ARRAY. THE 00950011 ! 99: C CONTINUE AND IF STATEMENTS HAVE EMBEDDED BLANKS AS WELL. 00960011 ! 100: C 00970011 ! 101: IF (ICZERO) 31030, 1030, 31030 00980011 ! 102: 1030 CONTINUE 00990011 ! 103: D O 1 IVON01 =1 , 3 , 1 01000011 ! 104: IADN11(IVON01) = IVON01 01010011 ! 105: 1 C ON T IN UE 01020011 ! 106: GO TO 41030 01030011 ! 107: 31030 IVDELE = IVDELE + 1 01040011 ! 108: WRITE (I02,80003) IVTNUM 01050011 ! 109: IF (ICZERO) 41030, 1041, 41030 01060011 ! 110: 41030 I F (IADN11(2) - 2) 21030,11030,21030 01070011 ! 111: 11030 IVPASS = IVPASS + 1 01080011 ! 112: WRITE (I02,80001) IVTNUM 01090011 ! 113: GO TO 1041 01100011 ! 114: 21030 IVFAIL = IVFAIL + 1 01110011 ! 115: IVCOMP = IADN11(2) 01120011 ! 116: IVCORR = 2 01130011 ! 117: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01140011 ! 118: 1041 CONTINUE 01150011 ! 119: IVTNUM = 104 01160011 ! 120: C 01170011 ! 121: C **** TEST 104 **** 01180011 ! 122: C TEST 104 - THIS TESTS EMBEDDED BLANKS IN AN INTEGER TYPE 01190011 ! 123: C STATEMENT. FRACTION 1/2 SHOULD BECOME 0 AS AN INTEGER. 01200011 ! 124: C INTEGER TO REAL * 2. BACK TO INTEGER CONVERSION SHOULD BE 0.01210011 ! 125: C 01220011 ! 126: IF (ICZERO) 31040, 1040, 31040 01230011 ! 127: 1040 CONTINUE 01240011 ! 128: RVTNI1 = 2 01250011 ! 129: RVON01 = 1/RVTNI1 01260011 ! 130: IVON02 = RVON01 * 2. 01270011 ! 131: GO TO 41040 01280011 ! 132: 31040 IVDELE = IVDELE + 1 01290011 ! 133: WRITE (I02,80003) IVTNUM 01300011 ! 134: IF (ICZERO) 41040, 1051, 41040 01310011 ! 135: 41040 IF( IVON02 - 0 ) 21040,11040,21040 01320011 ! 136: 11040 IVPASS = IVPASS + 1 01330011 ! 137: WRITE (I02,80001) IVTNUM 01340011 ! 138: GO TO 1051 01350011 ! 139: 21040 IVFAIL = IVFAIL + 1 01360011 ! 140: IVCOMP = IVON02 01370011 ! 141: IVCORR = 0 01380011 ! 142: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01390011 ! 143: 1051 CONTINUE 01400011 ! 144: IVTNUM = 105 01410011 ! 145: C 01420011 ! 146: C **** TEST 105 **** 01430011 ! 147: C TEST 105 - TEST OF EMBEDDED BLANKS IN A REAL TYPE STATEMENT. 01440011 ! 148: C REAL TO REAL*2. TO INTEGER CONVERSION IS PERFORMED. RESULT 01450011 ! 149: C IS 1 IF THE TYPE OF THE TEST VARIABLE(IVTNR1) WAS REAL. 01460011 ! 150: C 01470011 ! 151: IF (ICZERO) 31050, 1050, 31050 01480011 ! 152: 1050 CONTINUE 01490011 ! 153: IVTNR1 = .5 01500011 ! 154: RVON03 = IVTNR1*2. 01510011 ! 155: IVON03 = RVON03 +.3 01520011 ! 156: GO TO 41050 01530011 ! 157: 31050 IVDELE = IVDELE + 1 01540011 ! 158: WRITE (I02,80003) IVTNUM 01550011 ! 159: IF (ICZERO) 41050, 1061, 41050 01560011 ! 160: 41050 IF(IVON03 - 1) 21050, 11050, 21050 01570011 ! 161: 11050 IVPASS = IVPASS + 1 01580011 ! 162: WRITE (I02,80001) IVTNUM 01590011 ! 163: GO TO 1061 01600011 ! 164: 21050 IVFAIL = IVFAIL + 1 01610011 ! 165: IVCOMP = IVON03 01620011 ! 166: IVCORR = 1 01630011 ! 167: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01640011 ! 168: 1061 CONTINUE 01650011 ! 169: IVTNUM = 106 01660011 ! 170: C 01670011 ! 171: C **** TEST 106 **** 01680011 ! 172: C TEST 106 - TEST THE LOGICAL TYPE WITH EMBEDDED BLANKS BY A 01690011 ! 173: C LOGIC ASSIGNMENT (V = .TRUE.) SECTION 4.7.1 AND 10.2 01700011 ! 174: C 01710011 ! 175: IF (ICZERO) 31060, 1060, 31060 01720011 ! 176: 1060 CONTINUE 01730011 ! 177: LVTNL1 = .TRUE. 01740011 ! 178: GO TO 41060 01750011 ! 179: 31060 IVDELE = IVDELE + 1 01760011 ! 180: WRITE (I02,80003) IVTNUM 01770011 ! 181: IF (ICZERO) 41060, 1071, 41060 01780011 ! 182: 41060 IF(ICZERO) 21060,11060,21060 01790011 ! 183: 11060 IVPASS = IVPASS + 1 01800011 ! 184: WRITE (I02,80001) IVTNUM 01810011 ! 185: GO TO 1071 01820011 ! 186: 21060 IVFAIL = IVFAIL + 1 01830011 ! 187: WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR 01840011 ! 188: 1071 CONTINUE 01850011 ! 189: IVTNUM = 107 01860011 ! 190: C 01870011 ! 191: C **** TEST 107 **** 01880011 ! 192: C TEST 107 - A SECOND TEST OF THE LOGICAL TYPE STATEMENT WITH 01890011 ! 193: C EMBEDDED BLANKS. THE TEST IS AGAIN MADE BY A LOGICAL 01900011 ! 194: C ASSIGNMENT (SECTION 4.7.1 AND 10.2). 01910011 ! 195: C 01920011 ! 196: IF (ICZERO) 31070, 1070, 31070 01930011 ! 197: 1070 CONTINUE 01940011 ! 198: LVTNL2 = .FALSE. 01950011 ! 199: GO TO 41070 01960011 ! 200: 31070 IVDELE = IVDELE + 1 01970011 ! 201: WRITE (I02,80003) IVTNUM 01980011 ! 202: IF (ICZERO) 41070, 1081, 41070 01990011 ! 203: 41070 IF(ICZERO) 21070,11070,21070 02000011 ! 204: 11070 IVPASS = IVPASS + 1 02010011 ! 205: WRITE (I02,80001) IVTNUM 02020011 ! 206: GO TO 1081 02030011 ! 207: 21070 IVFAIL = IVFAIL + 1 02040011 ! 208: WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR 02050011 ! 209: 1081 CONTINUE 02060011 ! 210: IVTNUM = 108 02070011 ! 211: C 02080011 ! 212: C **** TEST 108 **** 02090011 ! 213: C TEST 108 - THIS IS A TEST OF BLANKS EMBEDDED IN THE COMMON, 02100011 ! 214: C DIMENSION AND EQUIVALENCE STATEMENTS (SECTION 8.1, 02110011 ! 215: C 8.3. AND 8.2.). 02120011 ! 216: C 02130011 ! 217: IF (ICZERO) 31080, 1080, 31080 02140011 ! 218: 1080 CONTINUE 02150011 ! 219: IADN11(3) = 4 02160011 ! 220: GO TO 41080 02170011 ! 221: 31080 IVDELE = IVDELE + 1 02180011 ! 222: WRITE (I02,80003) IVTNUM 02190011 ! 223: IF (ICZERO) 41080, 1091, 41080 02200011 ! 224: 41080 IF(IACE11(3) - 4) 21080,11080,21080 02210011 ! 225: 11080 IVPASS = IVPASS + 1 02220011 ! 226: WRITE (I02,80001) IVTNUM 02230011 ! 227: GO TO 1091 02240011 ! 228: 21080 IVFAIL = IVFAIL + 1 02250011 ! 229: IVCOMP = IACE11(3) 02260011 ! 230: IVCORR = 4 02270011 ! 231: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02280011 ! 232: 1091 CONTINUE 02290011 ! 233: IVTNUM = 109 02300011 ! 234: C 02310011 ! 235: C **** TEST 109 **** 02320011 ! 236: C TEST 109 - THIS TESTS THE EFFECT OF BLANKS EMBEDDED IN THE 02330011 ! 237: C DATA STATEMENT BY CHECKING THE INITIALIZATION OF ARRAY 02340011 ! 238: C ELEMENT VALUES (SECTION 9). 02350011 ! 239: C 02360011 ! 240: IF (ICZERO) 31090, 1090, 31090 02370011 ! 241: 1090 CONTINUE 02380011 ! 242: IVON04 = IADN12(1) + IADN12(2) + IADN12(3) 02390011 ! 243: GO TO 41090 02400011 ! 244: 31090 IVDELE = IVDELE + 1 02410011 ! 245: WRITE (I02,80003) IVTNUM 02420011 ! 246: IF (ICZERO) 41090, 1101, 41090 02430011 ! 247: 41090 IF(IVON04 - 9) 21090,11090,21090 02440011 ! 248: 11090 IVPASS = IVPASS + 1 02450011 ! 249: WRITE (I02,80001) IVTNUM 02460011 ! 250: GO TO 1101 02470011 ! 251: 21090 IVFAIL = IVFAIL + 1 02480011 ! 252: IVCOMP = IVON04 02490011 ! 253: IVCORR = 9 02500011 ! 254: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02510011 ! 255: 1101 CONTINUE 02520011 ! 256: C 02530011 ! 257: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02540011 ! 258: 99999 CONTINUE 02550011 ! 259: WRITE (I02,90002) 02560011 ! 260: WRITE (I02,90006) 02570011 ! 261: WRITE (I02,90002) 02580011 ! 262: WRITE (I02,90002) 02590011 ! 263: WRITE (I02,90007) 02600011 ! 264: WRITE (I02,90002) 02610011 ! 265: WRITE (I02,90008) IVFAIL 02620011 ! 266: WRITE (I02,90009) IVPASS 02630011 ! 267: WRITE (I02,90010) IVDELE 02640011 ! 268: C 02650011 ! 269: C 02660011 ! 270: C TERMINATE ROUTINE EXECUTION 02670011 ! 271: STOP 02680011 ! 272: C 02690011 ! 273: C FORMAT STATEMENTS FOR PAGE HEADERS 02700011 ! 274: 90000 FORMAT (1H1) 02710011 ! 275: 90002 FORMAT (1H ) 02720011 ! 276: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02730011 ! 277: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02740011 ! 278: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02750011 ! 279: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02760011 ! 280: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02770011 ! 281: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02780011 ! 282: C 02790011 ! 283: C FORMAT STATEMENTS FOR RUN SUMMARIES 02800011 ! 284: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02810011 ! 285: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02820011 ! 286: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02830011 ! 287: C 02840011 ! 288: C FORMAT STATEMENTS FOR TEST RESULTS 02850011 ! 289: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02860011 ! 290: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02870011 ! 291: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02880011 ! 292: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02890011 ! 293: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02900011 ! 294: C 02910011 ! 295: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM011) 02920011 ! 296: END 02930011
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.