|
|
1.1 root 1: C 00010014
2: C DATE***82/08/02*18.33.46
3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
4: C AUDIT FCVS78 V2.0
5: C COMMENT SECTION. 00020014
6: C 00030014
7: C FM014 00040014
8: C 00050014
9: C THIS ROUTINE TESTS THE FORTRAN COMPUTED GO TO STATEMENT.00060014
10: C BECAUSE THE FORM OF THE COMPUTED GO TO IS SO STRAIGHTFORWARD, THE 00070014
11: C TESTS MAINLY RELATE TO THE RANGE OF POSSIBLE STATEMENT NUMBERS 00080014
12: C WHICH ARE USED. 00090014
13: C 00100014
14: C REFERENCES 00110014
15: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00120014
16: C X3.9-1978 00130014
17: C 00140014
18: C SECTION 11.2, COMPUTED GO TO STATEMENT 00150014
19: C 00160014
20: C 00170014
21: C ********************************************************** 00180014
22: C 00190014
23: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200014
24: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00210014
25: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00220014
26: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00230014
27: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00240014
28: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00250014
29: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00260014
30: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00270014
31: C OF EXECUTING THESE TESTS. 00280014
32: C 00290014
33: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00300014
34: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00310014
35: C 00320014
36: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00330014
37: C 00340014
38: C DEPARTMENT OF THE NAVY 00350014
39: C FEDERAL COBOL COMPILER TESTING SERVICE 00360014
40: C WASHINGTON, D.C. 20376 00370014
41: C 00380014
42: C ********************************************************** 00390014
43: C 00400014
44: C 00410014
45: C 00420014
46: C INITIALIZATION SECTION 00430014
47: C 00440014
48: C INITIALIZE CONSTANTS 00450014
49: C ************** 00460014
50: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00470014
51: I01 = 5 00480014
52: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00490014
53: I02 = 6 00500014
54: C SYSTEM ENVIRONMENT SECTION 00510014
55: C 00520014
56: I01 = 5 00530014
57: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00540014
58: C (UNIT NUMBER FOR CARD READER). 00550014
59: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00560014
60: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00570014
61: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00580014
62: C 00590014
63: I02 = 6 00600014
64: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00610014
65: C (UNIT NUMBER FOR PRINTER). 00620014
66: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00630014
67: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00640014
68: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00650014
69: C 00660014
70: IVPASS=0 00670014
71: IVFAIL=0 00680014
72: IVDELE=0 00690014
73: ICZERO=0 00700014
74: C 00710014
75: C WRITE PAGE HEADERS 00720014
76: WRITE (I02,90000) 00730014
77: WRITE (I02,90001) 00740014
78: WRITE (I02,90002) 00750014
79: WRITE (I02, 90002) 00760014
80: WRITE (I02,90003) 00770014
81: WRITE (I02,90002) 00780014
82: WRITE (I02,90004) 00790014
83: WRITE (I02,90002) 00800014
84: WRITE (I02,90011) 00810014
85: WRITE (I02,90002) 00820014
86: WRITE (I02,90002) 00830014
87: WRITE (I02,90005) 00840014
88: WRITE (I02,90006) 00850014
89: WRITE (I02,90002) 00860014
90: IVTNUM = 131 00870014
91: C 00880014
92: C TEST 131 - TEST OF THE SIMPLIST FORM OF THE COMPUTED GO TO 00890014
93: C STATEMENT WITH THREE POSSIBLE BRANCHES. 00900014
94: C 00910014
95: C 00920014
96: IF (ICZERO) 31310, 1310, 31310 00930014
97: 1310 CONTINUE 00940014
98: ICON01=0 00950014
99: I=3 00960014
100: GO TO ( 1312, 1313, 1314 ), I 00970014
101: 1312 ICON01 = 1312 00980014
102: GO TO 1315 00990014
103: 1313 ICON01 = 1313 01000014
104: GO TO 1315 01010014
105: 1314 ICON01 = 1314 01020014
106: 1315 CONTINUE 01030014
107: GO TO 41310 01040014
108: 31310 IVDELE = IVDELE + 1 01050014
109: WRITE (I02,80003) IVTNUM 01060014
110: IF (ICZERO) 41310, 1321, 41310 01070014
111: 41310 IF ( ICON01 - 1314 ) 21310, 11310, 21310 01080014
112: 11310 IVPASS = IVPASS + 1 01090014
113: WRITE (I02,80001) IVTNUM 01100014
114: GO TO 1321 01110014
115: 21310 IVFAIL = IVFAIL + 1 01120014
116: IVCOMP=ICON01 01130014
117: IVCORR = 1314 01140014
118: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01150014
119: 1321 CONTINUE 01160014
120: IVTNUM = 132 01170014
121: C 01180014
122: C TEST 132 - THIS TESTS THE COMPUTED GO TO IN CONJUNCTION WITH THE01190014
123: C THE UNCONDITIONAL GO TO STATEMENT. THIS TEST IS NOT 01200014
124: C INTENDED TO BE AN EXAMPLE OF GOOD STRUCTURED PROGRAMMING. 01210014
125: C 01220014
126: C 01230014
127: IF (ICZERO) 31320, 1320, 31320 01240014
128: 1320 CONTINUE 01250014
129: IVON01=0 01260014
130: J=1 01270014
131: GO TO 1326 01280014
132: 1322 J = 2 01290014
133: IVON01=IVON01+2 01300014
134: GO TO 1326 01310014
135: 1323 J = 3 01320014
136: IVON01=IVON01 * 10 + 3 01330014
137: GO TO 1326 01340014
138: 1324 J = 4 01350014
139: IVON01=IVON01 * 100 + 4 01360014
140: GO TO 1326 01370014
141: 1325 IVON01 = IVON01 + 1 01380014
142: GO TO 1327 01390014
143: 1326 GO TO ( 1322, 1323, 1324, 1325, 1326 ), J 01400014
144: 1327 CONTINUE 01410014
145: GO TO 41320 01420014
146: 31320 IVDELE = IVDELE + 1 01430014
147: WRITE (I02,80003) IVTNUM 01440014
148: IF (ICZERO) 41320, 1331, 41320 01450014
149: 41320 IF ( IVON01 - 2305 ) 21320, 11320, 21320 01460014
150: 11320 IVPASS = IVPASS + 1 01470014
151: WRITE (I02,80001) IVTNUM 01480014
152: GO TO 1331 01490014
153: 21320 IVFAIL = IVFAIL + 1 01500014
154: IVCOMP=IVON01 01510014
155: IVCORR=2305 01520014
156: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01530014
157: 1331 CONTINUE 01540014
158: IVTNUM = 133 01550014
159: C 01560014
160: C TEST 133 - THIS IS A TEST OF THE COMPUTED GO TO STATEMENT WITH 01570014
161: C A SINGLE STATEMENT LABEL AS THE LIST OF POSSIBLE BRANCHES. 01580014
162: C 01590014
163: C 01600014
164: IF (ICZERO) 31330, 1330, 31330 01610014
165: 1330 CONTINUE 01620014
166: IVON01=0 01630014
167: K=1 01640014
168: GO TO ( 1332 ), K 01650014
169: 1332 IVON01 = 1 01660014
170: GO TO 41330 01670014
171: 31330 IVDELE = IVDELE + 1 01680014
172: WRITE (I02,80003) IVTNUM 01690014
173: IF (ICZERO) 41330, 1341, 41330 01700014
174: 41330 IF ( IVON01 - 1 ) 21330, 11330, 21330 01710014
175: 11330 IVPASS = IVPASS + 1 01720014
176: WRITE (I02,80001) IVTNUM 01730014
177: GO TO 1341 01740014
178: 21330 IVFAIL = IVFAIL + 1 01750014
179: IVCOMP=IVON01 01760014
180: IVCORR=1 01770014
181: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780014
182: 1341 CONTINUE 01790014
183: IVTNUM = 134 01800014
184: C 01810014
185: C TEST 134 - THIS IS A TEST OF FIVE (5) DIGIT STATEMENT NUMBERS 01820014
186: C WHICH EXCEED THE INTEGER 32767 USED IN THE COMPUTED GO TO 01830014
187: C STATEMENT WITH THREE POSSIBLE BRANCHES. 01840014
188: C 01850014
189: C 01860014
190: IF (ICZERO) 31340, 1340, 31340 01870014
191: 1340 CONTINUE 01880014
192: IVON01=0 01890014
193: L=2 01900014
194: GO TO ( 99991, 99992, 99993 ), L 01910014
195: 99991 IVON01=1 01920014
196: GO TO 1342 01930014
197: 99992 IVON01=2 01940014
198: GO TO 1342 01950014
199: 99993 IVON01=3 01960014
200: 1342 CONTINUE 01970014
201: GO TO 41340 01980014
202: 31340 IVDELE = IVDELE + 1 01990014
203: WRITE (I02,80003) IVTNUM 02000014
204: IF (ICZERO) 41340, 1351, 41340 02010014
205: 41340 IF ( IVON01 - 2 ) 21340, 11340, 21340 02020014
206: 11340 IVPASS = IVPASS + 1 02030014
207: WRITE (I02,80001) IVTNUM 02040014
208: GO TO 1351 02050014
209: 21340 IVFAIL = IVFAIL + 1 02060014
210: IVCOMP=IVON01 02070014
211: IVCORR=2 02080014
212: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02090014
213: 1351 CONTINUE 02100014
214: C 02110014
215: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02120014
216: 99999 CONTINUE 02130014
217: WRITE (I02,90002) 02140014
218: WRITE (I02,90006) 02150014
219: WRITE (I02,90002) 02160014
220: WRITE (I02,90002) 02170014
221: WRITE (I02,90007) 02180014
222: WRITE (I02,90002) 02190014
223: WRITE (I02,90008) IVFAIL 02200014
224: WRITE (I02,90009) IVPASS 02210014
225: WRITE (I02,90010) IVDELE 02220014
226: C 02230014
227: C 02240014
228: C TERMINATE ROUTINE EXECUTION 02250014
229: STOP 02260014
230: C 02270014
231: C FORMAT STATEMENTS FOR PAGE HEADERS 02280014
232: 90000 FORMAT (1H1) 02290014
233: 90002 FORMAT (1H ) 02300014
234: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02310014
235: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02320014
236: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02330014
237: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02340014
238: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02350014
239: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02360014
240: C 02370014
241: C FORMAT STATEMENTS FOR RUN SUMMARIES 02380014
242: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02390014
243: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02400014
244: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02410014
245: C 02420014
246: C FORMAT STATEMENTS FOR TEST RESULTS 02430014
247: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02440014
248: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02450014
249: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02460014
250: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02470014
251: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02480014
252: C 02490014
253: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM014) 02500014
254: END 02510014
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.