C COMMENT SECTION. C C FM011 C C THIS ROUTINE IS A TEST OF BLANK CHARACTERS (SECTION 3.1.6) C WHICH SHOULD HAVE NO MEANING WHEN EMBEDDED IN FORTRAN RESERVED C WORDS. C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 3.1.6, BLANK CHARACTER DIM EN SION IADN11(3),IADN12(3) IN TEGER RVTNI1 REA L IVTNR1 LOG ICAL LVTNL1,LVTNL2 COM MON IACE11(3) EQU IVAL ENCE (IACE11(1),IADN11(1)) D A T A IADN12/3*3/ C C ********************************************************** C C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT C OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - C C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ********************************************************** C C C C INITIALIZATION SECTION C C INITIALIZE CONSTANTS C ************** C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. I01 = 5 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. I02 = 6 C SYSTEM ENVIRONMENT SECTION C CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 C (UNIT NUMBER FOR CARD READER). CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. C CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 C (UNIT NUMBER FOR PRINTER). CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. C IVPASS=0 IVFAIL=0 IVDELE=0 ICZERO=0 C C WRITE PAGE HEADERS WRITE (I02,90000) WRITE (I02,90001) WRITE (I02,90002) WRITE (I02, 90002) WRITE (I02,90003) WRITE (I02,90002) WRITE (I02,90004) WRITE (I02,90002) WRITE (I02,90011) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90005) WRITE (I02,90006) WRITE (I02,90002) IVTNUM = 103 C C **** TEST 103 **** C TEST 103 - THIS TEST HAS BLANKS EMBEDDED IN A DIMENSION C STATEMENT. ALSO THE DO STATEMENT WITH AN EMBEDDED BLANK C WILL BE TESTED TO INITIALIZE VALUES IN AN ARRAY. THE C CONTINUE AND IF STATEMENTS HAVE EMBEDDED BLANKS AS WELL. C IF (ICZERO) 31030, 1030, 31030 1030 CONTINUE D O 1 IVON01 =1 , 3 , 1 IADN11(IVON01) = IVON01 1 C ON T IN UE GO TO 41030 31030 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41030, 1041, 41030 41030 I F (IADN11(2) - 2) 21030,11030,21030 11030 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1041 21030 IVFAIL = IVFAIL + 1 IVCOMP = IADN11(2) IVCORR = 2 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1041 CONTINUE IVTNUM = 104 C C **** TEST 104 **** C TEST 104 - THIS TESTS EMBEDDED BLANKS IN AN INTEGER TYPE C STATEMENT. FRACTION 1/2 SHOULD BECOME 0 AS AN INTEGER. C INTEGER TO REAL * 2. BACK TO INTEGER CONVERSION SHOULD BE 0. C IF (ICZERO) 31040, 1040, 31040 1040 CONTINUE RVTNI1 = 2 RVON01 = 1/RVTNI1 IVON02 = RVON01 * 2. GO TO 41040 31040 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41040, 1051, 41040 41040 IF( IVON02 - 0 ) 21040,11040,21040 11040 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1051 21040 IVFAIL = IVFAIL + 1 IVCOMP = IVON02 IVCORR = 0 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1051 CONTINUE IVTNUM = 105 C C **** TEST 105 **** C TEST 105 - TEST OF EMBEDDED BLANKS IN A REAL TYPE STATEMENT. C REAL TO REAL*2. TO INTEGER CONVERSION IS PERFORMED. RESULT C IS 1 IF THE TYPE OF THE TEST VARIABLE(IVTNR1) WAS REAL. C IF (ICZERO) 31050, 1050, 31050 1050 CONTINUE IVTNR1 = .5 RVON03 = IVTNR1*2. IVON03 = RVON03 +.3 GO TO 41050 31050 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41050, 1061, 41050 41050 IF(IVON03 - 1) 21050, 11050, 21050 11050 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1061 21050 IVFAIL = IVFAIL + 1 IVCOMP = IVON03 IVCORR = 1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1061 CONTINUE IVTNUM = 106 C C **** TEST 106 **** C TEST 106 - TEST THE LOGICAL TYPE WITH EMBEDDED BLANKS BY A C LOGIC ASSIGNMENT (V = .TRUE.) SECTION 4.7.1 AND 10.2 C IF (ICZERO) 31060, 1060, 31060 1060 CONTINUE LVTNL1 = .TRUE. GO TO 41060 31060 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41060, 1071, 41060 41060 IF(ICZERO) 21060,11060,21060 11060 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1071 21060 IVFAIL = IVFAIL + 1 WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR 1071 CONTINUE IVTNUM = 107 C C **** TEST 107 **** C TEST 107 - A SECOND TEST OF THE LOGICAL TYPE STATEMENT WITH C EMBEDDED BLANKS. THE TEST IS AGAIN MADE BY A LOGICAL C ASSIGNMENT (SECTION 4.7.1 AND 10.2). C IF (ICZERO) 31070, 1070, 31070 1070 CONTINUE LVTNL2 = .FALSE. GO TO 41070 31070 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41070, 1081, 41070 41070 IF(ICZERO) 21070,11070,21070 11070 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1081 21070 IVFAIL = IVFAIL + 1 WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR 1081 CONTINUE IVTNUM = 108 C C **** TEST 108 **** C TEST 108 - THIS IS A TEST OF BLANKS EMBEDDED IN THE COMMON, C DIMENSION AND EQUIVALENCE STATEMENTS (SECTION 8.1, C 8.3. AND 8.2.). C IF (ICZERO) 31080, 1080, 31080 1080 CONTINUE IADN11(3) = 4 GO TO 41080 31080 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41080, 1091, 41080 41080 IF(IACE11(3) - 4) 21080,11080,21080 11080 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1091 21080 IVFAIL = IVFAIL + 1 IVCOMP = IACE11(3) IVCORR = 4 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1091 CONTINUE IVTNUM = 109 C C **** TEST 109 **** C TEST 109 - THIS TESTS THE EFFECT OF BLANKS EMBEDDED IN THE C DATA STATEMENT BY CHECKING THE INITIALIZATION OF ARRAY C ELEMENT VALUES (SECTION 9). C IF (ICZERO) 31090, 1090, 31090 1090 CONTINUE IVON04 = IADN12(1) + IADN12(2) + IADN12(3) GO TO 41090 31090 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41090, 1101, 41090 41090 IF(IVON04 - 9) 21090,11090,21090 11090 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1101 21090 IVFAIL = IVFAIL + 1 IVCOMP = IVON04 IVCORR = 9 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1101 CONTINUE C C WRITE PAGE FOOTINGS AND RUN SUMMARIES 99999 CONTINUE WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90007) WRITE (I02,90002) WRITE (I02,90008) IVFAIL WRITE (I02,90009) IVPASS WRITE (I02,90010) IVDELE C C C TERMINATE ROUTINE EXECUTION STOP C C FORMAT STATEMENTS FOR PAGE HEADERS 90000 FORMAT (1H1) 90002 FORMAT (1H ) 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90003 FORMAT (1H ,21X,11HVERSION 1.0) 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 90006 FORMAT (1H ,5X,46H----------------------------------------------) 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARIES 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) C C FORMAT STATEMENTS FOR TEST RESULTS 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) C 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM011) END