PROGRAM FM252 C C C C C THIS PROGRAM TESTS REDEFINITION OF STATEMENT LABELS WITH THE C ASSIGN STATEMENT IN CONJUNCTION WITH THE ASSIGNED GO TO STATEMENT. C THE OPTIONAL COMMA IN THE SYNTAX OF THE ASSIGNED GO TO IS TESTED. C THE RANGE OF STATEMENT LABELS ( FROM 00001 TO 99999 ) IS TESTED C USING THE ASSIGN STATEMENT AND THE ASSIGNED GO TO STATEMENT. C IT ALSO TESTS THE OPTIONAL COMMA IN THE SYNTAX OF THE COMPUTED C GO TO STATEMENT AND HAS TESTS ON THE RANGE OF THE INDEX IN THE C COMPUTED GO TO. C C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN) C SECTION 11.2, COMPUTED GO TO STATEMENT C SECTION 11.3, ASSIGNED GO TO STATEMENT C C C FM013 - SUBSET LEVEL TESTS OF THE ASSIGN STATEMENT AND THE C ASSIGNED GO TO STATEMENT. C C FM014, FM052, AND FM053 - SUBSET LEVEL TESTS OF THE COMPUTED C GO TO STATEMENT. C C C C C ****************************************************************** C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING C THE RESULT OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES C FOUND IN THE SUBSET LEVEL OF THE STANDARD. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ****************************************************************** C C IMPLICIT LOGICAL (L) IMPLICIT CHARACTER*14 (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 PEPLACED 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 PEPLACED 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 OUT PAGE HEADERS C WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90008) WRITE (I02,90004) WRITE (I02,90010) WRITE (I02,90004) WRITE (I02,90016) WRITE (I02,90001) WRITE (I02,90004) WRITE (I02,90012) WRITE (I02,90014) WRITE (I02,90004) C C C **** FCVS PROGRAM 252 - TEST 001 **** C C TEST 001 IS AN ASSIGN STATEMENT IN WHICH THE STATEMENT C LABEL IS ACTUALLY FOR A FORMAT STATEMENT. IN 10.3 - THE STATEMENT C LABEL MUST BE THE LABEL OF AN EXECUTABLE STATEMENT OR A FORMAT C STATEMENT. THE ASSIGN STATEMENT IS FOLLOWED BY A SIMPLE WRITE C TO THE PRINTER. C C IVTNUM = 1 IF (ICZERO) 30010, 0010, 30010 0010 CONTINUE ASSIGN 0012 TO I 0012 FORMAT (51H **** ASSIGN FORMAT NUMBER TO INTEGER VARIABLE ****) WRITE (I02, I) C ***** VISUALLY CHECK THE OUTPUT PRINTER LISTING ***** IVCOMP = 0 IVCORR = 0 40010 IF ( IVCOMP ) 20010, 10010, 20010 30010 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10010, 0021, 20010 10010 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0021 20010 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0021 CONTINUE C C **** FCVS PROGRAM 252 - TEST 002 **** C C TEST 002 IS A TEST OF THE ASSIGNED GO TO STATEMENT WITH THE C OPTIONAL COMMA INTENTIONALLY DELETED FROM THE SYNTAX. C GO TO I (S1, S2, S3) C C IVTNUM = 2 IF (ICZERO) 30020, 0020, 30020 0020 CONTINUE IVCOMP = 0 IVCORR = 1 ASSIGN 0023 TO J GO TO 0025 0022 IVCOMP = 0 GO TO 40020 0023 IVCOMP = 1 GO TO 40020 0024 IVCOMP = 0 GO TO 40020 0025 GO TO J (0022, 0023, 0024) C NOTE THAT THE OPTIONAL COMMA IS NOT PRESENT AFTER THE J IN C PREVIOUS ASSIGNED GO TO STATEMENT. 40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020 30020 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10020, 0031, 20020 10020 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0031 20020 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0031 CONTINUE C C **** FCVS PROGRAM 252 - TEST 003 **** C C TEST 003 USES A SERIES OF ASSIGN STATEMENTS TO TEST THAT THE C SAME STATEMENT LABEL AND INTEGER VARIABLE CAN BE USED IN A C MULTIPLE REDEFINITION TO THE SAME VALUES. A SIMPLE ASSIGNED C GO TO IS USED TO TEST THE VALUE OF THE INTEGER VARIABLE M. C C IVTNUM = 3 IF (ICZERO) 30030, 0030, 30030 0030 CONTINUE IVCOMP = 0 IVCORR = 1 ASSIGN 0033 TO M ASSIGN 0033 TO M ASSIGN 0033 TO M GO TO 0035 0032 IVCOMP = 0 GO TO 40030 0033 IVCOMP = 1 GO TO 40030 0034 IVCOMP = 0 GO TO 40030 0035 GO TO M, (0032, 0033, 0034) 40030 IF ( IVCOMP - 1 ) 20030, 10030, 20030 30030 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10030, 0041, 20030 10030 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0041 20030 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0041 CONTINUE C C **** FCVS PROGRAM 252 - TEST 004 **** C C TEST 004 USES A SERIES OF ASSIGN STATEMENTS TO SET THE INTEGER C VARIABLE K TO A STATEMENT LABEL IN THE PARENTHESIZED LIST OF C STATEMENT LABELS FOR THE ASSIGNED GO TO STATEMENT, THEN TO A C STATEMENT LABEL NOT IN THE LIST AND FINALLY BACK TO A PROPER C STATEMENT LABEL WITHIN THE PARENTHESIZED LIST. SECTION 11.3 C REQUIRES - IF THE PARENTHESIZED LIST IS PRESENT, THE STATEMENT C LABEL ASSIGNED TO I MUST BE ONE OF THE STATEMENT LABELS IN C THE LIST. AN ASSIGNED GO TO STATEMENT IS USED TO TEST THE FINAL C ASSIGNMENT OF STATEMENT LABELS TO THE INTEGER VARIABLE K. C C IVTNUM = 4 IF (ICZERO) 30040, 0040, 30040 0040 CONTINUE IVCOMP = 0 IVCORR = 1 ASSIGN 0043 TO K ASSIGN 0042 TO K 0042 ASSIGN 0043 TO K GO TO 0045 0043 IVCOMP = 1 GO TO 40040 0044 IVCOMP = 0 GO TO 40040 0045 GO TO K, (0044, 0043) 40040 IF ( IVCOMP - 1 ) 20040, 10040, 20040 30040 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10040, 0051, 20040 10040 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0051 20040 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0051 CONTINUE C C C THE FOLLOWING TWO TESTS CHECK THE POSSIBLE RANGE OF STATEMENT C LABELS ( FROM 00001 TO 99999 ) BY USING THEM IN ASSIGN STATEMENTS C AND ASSIGNED GO TO STATEMENTS. C C C C **** FCVS PROGRAM 252 - TEST 005 **** C C TEST 005 USES A STATEMENT LABEL OF 00001 WHICH IS THE SMALLEST C ALLOWABLE STATEMENT LABEL. C C IVTNUM = 5 IF (ICZERO) 30050, 0050, 30050 0050 CONTINUE IVCOMP = 0 IVCORR = 1 ASSIGN 00001 TO I GO TO 0054 0052 IVCOMP = 0 GO TO 40050 00001 IVCOMP = 1 GO TO 40050 0053 IVCOMP = 0 GO TO 40050 0054 GO TO I, ( 0052, 00001, 0053 ) 40050 IF ( IVCOMP - 1 ) 20050, 10050, 20050 30050 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10050, 0061, 20050 10050 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0061 20050 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0061 CONTINUE C C **** FCVS PROGRAM 252 - TEST 006 **** C C TEST 006 USES A STATEMENT LABEL OF 99999 WHICH IS THE LARGEST C ALLOWABLE STATEMENT LABEL. C C IVTNUM = 6 IF (ICZERO) 30060, 0060, 30060 0060 CONTINUE IVCOMP = 0 IVCORR = 1 ASSIGN 99999 TO J GO TO 0064 0062 IVCOMP = 0 GO TO 40060 99999 IVCOMP = 1 GO TO 40060 0063 IVCOMP = 0 GO TO 40060 0064 GO TO J, ( 0062, 99999, 0063 ) 40060 IF ( IVCOMP - 1 ) 20060, 10060, 20060 30060 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10060, 0071, 20060 10060 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0071 20060 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0071 CONTINUE C C **** FCVS PROGRAM 252 - TEST 007 **** C C TEST 007 IS A SYNTAX CHECK ON THE OPTIONAL COMMA IN THE C COMPUTED GO TO STATEMENT. THE COMMA FOLLOWING THE PARENTHESIZED C LIST OF STATEMENT LABELS IS INTENTIONALLY OMITTED. C GO TO ( S1, S2, S3 ) I C C IVTNUM = 7 IF (ICZERO) 30070, 0070, 30070 0070 CONTINUE IVCOMP = 0 IVCORR = 1 I = 3 GO TO 0075 0072 IVCOMP = 0 I = 1 GO TO 0075 0073 IVCOMP = 1 GO TO 40070 0074 IVCOMP = 0 I = 2 GO TO 0075 0075 GO TO ( 0074, 0073, 0072 ) I 40070 IF ( I - 2 ) 20070, 40071, 20070 40071 IF ( IVCOMP - 1 ) 20070, 10070, 20070 30070 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10070, 0081, 20070 10070 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0081 20070 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0081 CONTINUE C C **** FCVS PROGRAM 252 - TEST 008 **** C C TEST 008 USES THE COMPUTED GO TO WITHOUT THE OPTIONAL COMMA C AND HAS A SINGLE STATEMENT LABEL IN THE PARENTHESIZED LIST OF C STATEMENT LABELS. C GO TO ( S1 ) I C C IVTNUM = 8 IF (ICZERO) 30080, 0080, 30080 0080 CONTINUE IVCOMP = 0 IVCORR = 1 J = 1 GO TO 0083 0082 IVCOMP = 1 GO TO 40080 0083 GO TO ( 0082 ) J 40080 IF ( IVCOMP - 1 ) 20080, 10080, 20080 30080 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10080, 0091, 20080 10080 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0091 20080 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0091 CONTINUE C C C THE NEXT THREE TESTS OF THE COMPUTED GO TO TEST THE RANGE OF C THE INDEX. C C FORTRAN 77 HAS THE REQUIREMENT IN SECTION 11.2 - IF THE INDEX C IS LESS THAN ONE OR GREATER THAN THE NUMBER OF STATEMENT LABELS IN C THE PARENTHESIZED LIST, THE EXECUTION SEQUENCE CONTINUES AS THOUGH C A CONTINUE STATEMENT WERE EXECUTED. C C C C **** FCVS PROGRAM 252 - TEST 009 **** C C C TEST 009 USES A VALUE OF THE INDEX OF THE COMPUTED GO TO C STATEMENT GREATER THAN THE NUMBER OF STATEMENT LABELS IN THE C PARENTHESIZED LIST. C C IVTNUM = 9 IF (ICZERO) 30090, 0090, 30090 0090 CONTINUE IVCOMP = 0 IVCORR = 1 K = 3 GO TO 0094 0092 IVCOMP = 0 GO TO 40090 0093 IVCOMP = 0 GO TO 40090 0094 GO TO ( 0092, 0093 ) K C C TO REACH THIS STATEMENT THE COMPUTED GO TO WILL HAVE TO BE C EXECUTED AS IF IT WERE A CONTINUE STATEMENT. C IVCOMP = 1 40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090 30090 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10090, 0101, 20090 10090 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0101 20090 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0101 CONTINUE C C **** FCVS PROGRAM 252 - TEST 010 **** C C TEST 010 USES A VALUE OF THE INDEX OF THE COMPUTED GO TO C STATEMENT EQUAL TO ZERO. C C IVTNUM = 10 IF (ICZERO) 30100, 0100, 30100 0100 CONTINUE IVCOMP = 0 IVCORR = 1 I = 0 GO TO 0104 0102 IVCOMP = 0 GO TO 40100 0103 IVCOMP = 0 GO TO 40100 0104 GO TO ( 0103, 0102 ), I C C THIS STATEMENT CAN ONLY BE REACHED IF THE COMPUTED GO TO C IS EXECUTED AS IF IT WERE A CONTINUE STATEMENT. C IVCOMP = 1 40100 IF ( IVCOMP - 1 ) 20100, 10100, 20100 30100 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10100, 0111, 20100 10100 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0111 20100 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0111 CONTINUE C C **** FCVS PROGRAM 252 - TEST 011 **** C C TEST 011 USES A VALUE OF THE INDEX OF THE COMPUTED GO TO C EQUAL TO -1. C IVTNUM = 11 IF (ICZERO) 30110, 0110, 30110 0110 CONTINUE IVCOMP = 0 IVCORR = 1 J = -1 GO TO 0114 0112 IVCOMP = 0 GO TO 40110 0113 IVCOMP = 0 GO TO 40110 0114 GO TO (0112,0113),J C C THIS STATEMENT CAN ONLY BE REACHED IF THE COMPUTED GO TO C IS EXECUTED AS IF IT WERE A CONTINUE STATEMENT. C IVCOMP = 1 40110 IF ( IVCOMP - 1 ) 20110, 10110, 20110 30110 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10110, 0121, 20110 10110 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0121 20110 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0121 CONTINUE C C C WRITE OUT TEST SUMMARY C WRITE (I02,90004) WRITE (I02,90014) WRITE (I02,90004) WRITE (I02,90000) WRITE (I02,90004) WRITE (I02,90020) IVFAIL WRITE (I02,90022) IVPASS WRITE (I02,90024) IVDELE STOP 90001 FORMAT (1H ,24X,5HFM252) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM252) C C FORMATS FOR TEST DETAIL LINES C 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) C C FORMAT STATEMENTS FOR PAGE HEADERS C 90002 FORMAT (1H1) 90004 FORMAT (1H ) 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90008 FORMAT (1H ,21X,11HVERSION 1.0) 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 90014 FORMAT (1H ,5X,46H----------------------------------------------) 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARY C 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) END