blob: e22329a99296a20a9c4959598ee1509f14afbae0 [file] [log] [blame]
PROGRAM FM013
C 00010013
C COMMENT SECTION. 00020013
C 00030013
C FM013 00040013
C 00050013
C THIS ROUTINE TESTS THE FORTRAN ASSIGNED GO TO STATEMENT 00060013
C AS DESCRIBED IN SECTION 11.3 (ASSIGNED GO TO STATEMENT). FIRST A 00070013
C STATEMENT LABEL IS ASSIGNED TO AN INTEGER VARIABLE IN THE ASSIGN 00080013
C STATEMENT. SECONDLY A BRANCH IS MADE IN AN ASSIGNED GO TO 00090013
C STATEMENT USING THE INTEGER VARIABLE AS THE BRANCH CONTROLLER 00100013
C IN A LIST OF POSSIBLE STATEMENT NUMBERS TO BE BRANCHED TO. 00110013
C 00120013
C REFERENCES 00130013
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140013
C X3.9-1978 00150013
C 00160013
C SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN) STATEMENT 00170013
C SECTION 11.3, ASSIGNED GO TO STATEMENT 00180013
C 00190013
C 00200013
C ********************************************************** 00210013
C 00220013
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00230013
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00240013
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250013
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00260013
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270013
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00280013
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00290013
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300013
C OF EXECUTING THESE TESTS. 00310013
C 00320013
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330013
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00340013
C 00350013
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00360013
C 00370013
C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00380013
C SOFTWARE STANDARDS VALIDATION GROUP 00390013
C BUILDING 225 RM A266 00400013
C GAITHERSBURG, MD 20899 00410013
C ********************************************************** 00420013
C 00430013
C 00440013
C 00450013
C INITIALIZATION SECTION 00460013
C 00470013
C INITIALIZE CONSTANTS 00480013
C ************** 00490013
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00500013
I01 = 5 00510013
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00520013
I02 = 6 00530013
C SYSTEM ENVIRONMENT SECTION 00540013
C 00550013
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00560013
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00570013
C (UNIT NUMBER FOR CARD READER). 00580013
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590013
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00600013
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00610013
C 00620013
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00630013
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00640013
C (UNIT NUMBER FOR PRINTER). 00650013
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660013
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670013
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00680013
C 00690013
IVPASS=0 00700013
IVFAIL=0 00710013
IVDELE=0 00720013
ICZERO=0 00730013
C 00740013
C WRITE PAGE HEADERS 00750013
WRITE (I02,90000) 00760013
WRITE (I02,90001) 00770013
WRITE (I02,90002) 00780013
WRITE (I02, 90002) 00790013
WRITE (I02,90003) 00800013
WRITE (I02,90002) 00810013
WRITE (I02,90004) 00820013
WRITE (I02,90002) 00830013
WRITE (I02,90011) 00840013
WRITE (I02,90002) 00850013
WRITE (I02,90002) 00860013
WRITE (I02,90005) 00870013
WRITE (I02,90006) 00880013
WRITE (I02,90002) 00890013
IVTNUM = 126 00900013
C 00910013
C TEST 126 - THIS TESTS THE SIMPLE ASSIGN STATEMENT IN PREPARATION00920013
C FOR THE ASSIGNED GO TO TEST TO FOLLOW. 00930013
C THE ASSIGNED GO TO IS THE SIMPLIST FORM OF THE STATEMENT. 00940013
C 00950013
C 00960013
IF (ICZERO) 31260, 1260, 31260 00970013
1260 CONTINUE 00980013
ASSIGN 1263 TO I 00990013
GO TO I, (1262,1263,1264) 01000013
1262 ICON01 = 1262 01010013
GO TO 1265 01020013
1263 ICON01 = 1263 01030013
GO TO 1265 01040013
1264 ICON01 = 1264 01050013
1265 CONTINUE 01060013
GO TO 41260 01070013
31260 IVDELE = IVDELE + 1 01080013
WRITE (I02,80003) IVTNUM 01090013
IF (ICZERO) 41260, 1271, 41260 01100013
41260 IF ( ICON01 - 1263 ) 21260, 11260, 21260 01110013
11260 IVPASS = IVPASS + 1 01120013
WRITE (I02,80001) IVTNUM 01130013
GO TO 1271 01140013
21260 IVFAIL = IVFAIL + 1 01150013
IVCOMP=ICON01 01160013
IVCORR = 1263 01170013
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01180013
1271 CONTINUE 01190013
IVTNUM = 127 01200013
C 01210013
C TEST 127 - THIS IS A TEST OF MORE COMPLEX BRANCHING USING 01220013
C THE ASSIGN AND ASSIGNED GO TO STATEMENTS. THIS TEST IS NOT 01230013
C INTENDED TO BE AN EXAMPLE OF STRUCTURED PROGRAMMING. 01240013
C 01250013
C 01260013
IF (ICZERO) 31270, 1270, 31270 01270013
1270 CONTINUE 01280013
IVON01=0 01290013
1272 ASSIGN 1273 TO J 01300013
IVON01=IVON01+1 01310013
GO TO 1276 01320013
1273 ASSIGN 1274 TO J 01330013
IVON01=IVON01 * 10 + 2 01340013
GO TO 1276 01350013
1274 ASSIGN 1275 TO J 01360013
IVON01=IVON01 * 100 + 3 01370013
GO TO 1276 01380013
1275 GO TO 1277 01390013
1276 GO TO J, ( 1272, 1273, 1274, 1275 ) 01400013
1277 CONTINUE 01410013
GO TO 41270 01420013
31270 IVDELE = IVDELE + 1 01430013
WRITE (I02,80003) IVTNUM 01440013
IF (ICZERO) 41270, 1281, 41270 01450013
41270 IF ( IVON01 - 1203 ) 21270, 11270, 21270 01460013
11270 IVPASS = IVPASS + 1 01470013
WRITE (I02,80001) IVTNUM 01480013
GO TO 1281 01490013
21270 IVFAIL = IVFAIL + 1 01500013
IVCOMP=IVON01 01510013
IVCORR=1203 01520013
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01530013
1281 CONTINUE 01540013
IVTNUM = 128 01550013
C 01560013
C TEST 128 - TEST OF THE ASSIGNED GO TO WITH ALL OF THE 01570013
C STATEMENT NUMBERS IN THE ASSIGNED GO TO LIST THE SAME 01580013
C VALUE EXCEPT FOR ONE. 01590013
C 01600013
C 01610013
IF (ICZERO) 31280, 1280, 31280 01620013
1280 CONTINUE 01630013
ICON01=0 01640013
ASSIGN 1283 TO K 01650013
GO TO K, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 ) 01660013
1282 ICON01 = 0 01670013
GO TO 1284 01680013
1283 ICON01 = 1 01690013
1284 CONTINUE 01700013
GO TO 41280 01710013
31280 IVDELE = IVDELE + 1 01720013
WRITE (I02,80003) IVTNUM 01730013
IF (ICZERO) 41280, 1291, 41280 01740013
41280 IF ( ICON01 - 1 ) 21280, 11280, 21280 01750013
11280 IVPASS = IVPASS + 1 01760013
WRITE (I02,80001) IVTNUM 01770013
GO TO 1291 01780013
21280 IVFAIL = IVFAIL + 1 01790013
IVCOMP=ICON01 01800013
IVCORR=1 01810013
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01820013
1291 CONTINUE 01830013
IVTNUM = 129 01840013
C 01850013
C TEST 129 - THIS TESTS THE ASSIGN STATEMENT IN CONJUNCTION 01860013
C WITH THE NORMAL ARITHMETIC ASSIGN STATEMENT. THE VALUE 01870013
C OF THE INDEX FOR THE ASSIGNED GO TO STATEMENT IS CHANGED BY 01880013
C THE COMBINATION OF STATEMENTS. 01890013
C 01900013
C 01910013
IF (ICZERO) 31290, 1290, 31290 01920013
1290 CONTINUE 01930013
ICON01=0 01940013
ASSIGN 1292 TO L 01950013
L = 1293 01960013
ASSIGN 1294 TO L 01970013
GO TO L, ( 1294, 1293, 1292 ) 01980013
1292 ICON01 = 0 01990013
GO TO 1295 02000013
1293 ICON01 = 0 02010013
GO TO 1295 02020013
1294 ICON01 = 1 02030013
1295 CONTINUE 02040013
GO TO 41290 02050013
31290 IVDELE = IVDELE + 1 02060013
WRITE (I02,80003) IVTNUM 02070013
IF (ICZERO) 41290, 1301, 41290 02080013
41290 IF ( ICON01 - 1 ) 21290, 11290, 21290 02090013
11290 IVPASS = IVPASS + 1 02100013
WRITE (I02,80001) IVTNUM 02110013
GO TO 1301 02120013
21290 IVFAIL = IVFAIL + 1 02130013
IVCOMP=ICON01 02140013
IVCORR=1 02150013
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02160013
1301 CONTINUE 02170013
IVTNUM = 130 02180013
C 02190013
C TEST 130 - THIS IS A TEST OF A LOOP USING A COMBINATION OF THE 02200013
C ASSIGNED GO TO STATEMENT AND THE ARITHMETIC IF STATEMENT. 02210013
C THE LOOP SHOULD BE EXECUTED ELEVEN (11) TIMES THEN CONTROL 02220013
C SHOULD PASS TO THE CHECK OF THE VALUE FOR IVON01. 02230013
C 02240013
C 02250013
IF (ICZERO) 31300, 1300, 31300 02260013
1300 CONTINUE 02270013
IVON01=0 02280013
1302 ASSIGN 1302 TO M 02290013
IVON01=IVON01+1 02300013
IF ( IVON01 - 10 ) 1303, 1303, 1304 02310013
1303 GO TO 1305 02320013
1304 ASSIGN 1306 TO M 02330013
1305 GO TO M, ( 1302, 1306 ) 02340013
1306 CONTINUE 02350013
GO TO 41300 02360013
31300 IVDELE = IVDELE + 1 02370013
WRITE (I02,80003) IVTNUM 02380013
IF (ICZERO) 41300, 1311, 41300 02390013
41300 IF ( IVON01 - 11 ) 21300, 11300, 21300 02400013
11300 IVPASS = IVPASS + 1 02410013
WRITE (I02,80001) IVTNUM 02420013
GO TO 1311 02430013
21300 IVFAIL = IVFAIL + 1 02440013
IVCOMP=IVON01 02450013
IVCORR=11 02460013
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02470013
1311 CONTINUE 02480013
C 02490013
C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02500013
99999 CONTINUE 02510013
WRITE (I02,90002) 02520013
WRITE (I02,90006) 02530013
WRITE (I02,90002) 02540013
WRITE (I02,90002) 02550013
WRITE (I02,90007) 02560013
WRITE (I02,90002) 02570013
WRITE (I02,90008) IVFAIL 02580013
WRITE (I02,90009) IVPASS 02590013
WRITE (I02,90010) IVDELE 02600013
C 02610013
C 02620013
C TERMINATE ROUTINE EXECUTION 02630013
STOP 02640013
C 02650013
C FORMAT STATEMENTS FOR PAGE HEADERS 02660013
90000 FORMAT ("1") 02670013
90002 FORMAT (" ") 02680013
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02690013
90003 FORMAT (" ",21X,"VERSION 2.1" ) 02700013
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 02710013
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 02720013
90006 FORMAT (" ",5X,"----------------------------------------------" ) 02730013
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 02740013
C 02750013
C FORMAT STATEMENTS FOR RUN SUMMARIES 02760013
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 02770013
90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 02780013
90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 02790013
C 02800013
C FORMAT STATEMENTS FOR TEST RESULTS 02810013
80001 FORMAT (" ",4X,I5,7X,"PASS") 02820013
80002 FORMAT (" ",4X,I5,7X,"FAIL") 02830013
80003 FORMAT (" ",4X,I5,7X,"DELETED") 02840013
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 02850013
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 02860013
C 02870013
90007 FORMAT (" ",20X,"END OF PROGRAM FM013" ) 02880013
END 02890013