C C COMMENT SECTION. C C FM013 C C THIS ROUTINE TESTS THE FORTRAN ASSIGNED GO TO STATEMENT C AS DESCRIBED IN SECTION 11.3 (ASSIGNED GO TO STATEMENT). FIRST A C STATEMENT LABEL IS ASSIGNED TO AN INTEGER VARIABLE IN THE ASSIGN C STATEMENT. SECONDLY A BRANCH IS MADE IN AN ASSIGNED GO TO C STATEMENT USING THE INTEGER VARIABLE AS THE BRANCH CONTROLLER C IN A LIST OF POSSIBLE STATEMENT NUMBERS TO BE BRANCHED TO. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN) STATEMENT C SECTION 11.3, ASSIGNED 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 = 126 C C TEST 126 - THIS TESTS THE SIMPLE ASSIGN STATEMENT IN PREPARATION C FOR THE ASSIGNED GO TO TEST TO FOLLOW. C THE ASSIGNED GO TO IS THE SIMPLIST FORM OF THE STATEMENT. C C IF (ICZERO) 31260, 1260, 31260 1260 CONTINUE ASSIGN 1263 TO I GO TO I, (1262,1263,1264) 1262 ICON01 = 1262 GO TO 1265 1263 ICON01 = 1263 GO TO 1265 1264 ICON01 = 1264 1265 CONTINUE GO TO 41260 31260 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41260, 1271, 41260 41260 IF ( ICON01 - 1263 ) 21260, 11260, 21260 11260 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1271 21260 IVFAIL = IVFAIL + 1 IVCOMP=ICON01 IVCORR = 1263 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1271 CONTINUE IVTNUM = 127 C C TEST 127 - THIS IS A TEST OF MORE COMPLEX BRANCHING USING C THE ASSIGN AND ASSIGNED GO TO STATEMENTS. THIS TEST IS NOT C INTENDED TO BE AN EXAMPLE OF STRUCTURED PROGRAMMING. C C IF (ICZERO) 31270, 1270, 31270 1270 CONTINUE IVON01=0 1272 ASSIGN 1273 TO J IVON01=IVON01+1 GO TO 1276 1273 ASSIGN 1274 TO J IVON01=IVON01 * 10 + 2 GO TO 1276 1274 ASSIGN 1275 TO J IVON01=IVON01 * 100 + 3 GO TO 1276 1275 GO TO 1277 1276 GO TO J, ( 1272, 1273, 1274, 1275 ) 1277 CONTINUE GO TO 41270 31270 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41270, 1281, 41270 41270 IF ( IVON01 - 1203 ) 21270, 11270, 21270 11270 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1281 21270 IVFAIL = IVFAIL + 1 IVCOMP=IVON01 IVCORR=1203 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1281 CONTINUE IVTNUM = 128 C C TEST 128 - TEST OF THE ASSIGNED GO TO WITH ALL OF THE C STATEMENT NUMBERS IN THE ASSIGNED GO TO LIST THE SAME C VALUE EXCEPT FOR ONE. C C IF (ICZERO) 31280, 1280, 31280 1280 CONTINUE ICON01=0 ASSIGN 1283 TO K GO TO K, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 ) 1282 ICON01 = 0 GO TO 1284 1283 ICON01 = 1 1284 CONTINUE GO TO 41280 31280 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41280, 1291, 41280 41280 IF ( ICON01 - 1 ) 21280, 11280, 21280 11280 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1291 21280 IVFAIL = IVFAIL + 1 IVCOMP=ICON01 IVCORR=1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1291 CONTINUE IVTNUM = 129 C C TEST 129 - THIS TESTS THE ASSIGN STATEMENT IN CONJUNCTION C WITH THE NORMAL ARITHMETIC ASSIGN STATEMENT. THE VALUE C OF THE INDEX FOR THE ASSIGNED GO TO STATEMENT IS CHANGED BY C THE COMBINATION OF STATEMENTS. C C IF (ICZERO) 31290, 1290, 31290 1290 CONTINUE ICON01=0 ASSIGN 1292 TO L L = 1293 ASSIGN 1294 TO L GO TO L, ( 1294, 1293, 1292 ) 1292 ICON01 = 0 GO TO 1295 1293 ICON01 = 0 GO TO 1295 1294 ICON01 = 1 1295 CONTINUE GO TO 41290 31290 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41290, 1301, 41290 41290 IF ( ICON01 - 1 ) 21290, 11290, 21290 11290 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1301 21290 IVFAIL = IVFAIL + 1 IVCOMP=ICON01 IVCORR=1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1301 CONTINUE IVTNUM = 130 C C TEST 130 - THIS IS A TEST OF A LOOP USING A COMBINATION OF THE C ASSIGNED GO TO STATEMENT AND THE ARITHMETIC IF STATEMENT. C THE LOOP SHOULD BE EXECUTED ELEVEN (11) TIMES THEN CONTROL C SHOULD PASS TO THE CHECK OF THE VALUE FOR IVON01. C C IF (ICZERO) 31300, 1300, 31300 1300 CONTINUE IVON01=0 1302 ASSIGN 1302 TO M IVON01=IVON01+1 IF ( IVON01 - 10 ) 1303, 1303, 1304 1303 GO TO 1305 1304 ASSIGN 1306 TO M 1305 GO TO M, ( 1302, 1306 ) 1306 CONTINUE GO TO 41300 31300 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 41300, 1311, 41300 41300 IF ( IVON01 - 11 ) 21300, 11300, 21300 11300 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1311 21300 IVFAIL = IVFAIL + 1 IVCOMP=IVON01 IVCORR=11 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1311 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 FM013) END