C C COMMENT SECTION. C C FM014 C C THIS ROUTINE TESTS THE FORTRAN COMPUTED GO TO STATEMENT. C BECAUSE THE FORM OF THE COMPUTED GO TO IS SO STRAIGHTFORWARD, THE C TESTS MAINLY RELATE TO THE RANGE OF POSSIBLE STATEMENT NUMBERS C WHICH ARE USED. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 11.2, COMPUTED GO TO STATEMENT C 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 = 131 C C TEST 131 - TEST OF THE SIMPLIST FORM OF THE COMPUTED GO TO C STATEMENT WITH THREE POSSIBLE BRANCHES. C C IF (ICZERO) 31310, 1310, 31310 1310 CONTINUE ICON01=0 I=3 GO TO ( 1312, 1313, 1314 ), I 1312 ICON01 = 1312 GO TO 1315 1313 ICON01 = 1313 GO TO 1315 1314 ICON01 = 1314 1315 CONTINUE GO TO 41310 31310 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41310, 1321, 41310 41310 IF ( ICON01 - 1314 ) 21310, 11310, 21310 11310 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1321 21310 IVFAIL = IVFAIL + 1 IVCOMP=ICON01 IVCORR = 1314 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1321 CONTINUE IVTNUM = 132 C C TEST 132 - THIS TESTS THE COMPUTED GO TO IN CONJUNCTION WITH THE C THE UNCONDITIONAL GO TO STATEMENT. THIS TEST IS NOT C INTENDED TO BE AN EXAMPLE OF GOOD STRUCTURED PROGRAMMING. C C IF (ICZERO) 31320, 1320, 31320 1320 CONTINUE IVON01=0 J=1 GO TO 1326 1322 J = 2 IVON01=IVON01+2 GO TO 1326 1323 J = 3 IVON01=IVON01 * 10 + 3 GO TO 1326 1324 J = 4 IVON01=IVON01 * 100 + 4 GO TO 1326 1325 IVON01 = IVON01 + 1 GO TO 1327 1326 GO TO ( 1322, 1323, 1324, 1325, 1326 ), J 1327 CONTINUE GO TO 41320 31320 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41320, 1331, 41320 41320 IF ( IVON01 - 2305 ) 21320, 11320, 21320 11320 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1331 21320 IVFAIL = IVFAIL + 1 IVCOMP=IVON01 IVCORR=2305 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1331 CONTINUE IVTNUM = 133 C C TEST 133 - THIS IS A TEST OF THE COMPUTED GO TO STATEMENT WITH C A SINGLE STATEMENT LABEL AS THE LIST OF POSSIBLE BRANCHES. C C IF (ICZERO) 31330, 1330, 31330 1330 CONTINUE IVON01=0 K=1 GO TO ( 1332 ), K 1332 IVON01 = 1 GO TO 41330 31330 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41330, 1341, 41330 41330 IF ( IVON01 - 1 ) 21330, 11330, 21330 11330 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1341 21330 IVFAIL = IVFAIL + 1 IVCOMP=IVON01 IVCORR=1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1341 CONTINUE IVTNUM = 134 C C TEST 134 - THIS IS A TEST OF FIVE (5) DIGIT STATEMENT NUMBERS C WHICH EXCEED THE INTEGER 32767 USED IN THE COMPUTED GO TO C STATEMENT WITH THREE POSSIBLE BRANCHES. C C IF (ICZERO) 31340, 1340, 31340 1340 CONTINUE IVON01=0 L=2 GO TO ( 99991, 99992, 99993 ), L 99991 IVON01=1 GO TO 1342 99992 IVON01=2 GO TO 1342 99993 IVON01=3 1342 CONTINUE GO TO 41340 31340 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41340, 1351, 41340 41340 IF ( IVON01 - 2 ) 21340, 11340, 21340 11340 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1351 21340 IVFAIL = IVFAIL + 1 IVCOMP=IVON01 IVCORR=2 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1351 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 FM014) END