![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM013.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM013.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 root 1: C 00010013
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. 00020013
6: C 00030013
7: C FM013 00040013
8: C 00050013
9: C THIS ROUTINE TESTS THE FORTRAN ASSIGNED GO TO STATEMENT 00060013
10: C AS DESCRIBED IN SECTION 11.3 (ASSIGNED GO TO STATEMENT). FIRST A 00070013
11: C STATEMENT LABEL IS ASSIGNED TO AN INTEGER VARIABLE IN THE ASSIGN 00080013
12: C STATEMENT. SECONDLY A BRANCH IS MADE IN AN ASSIGNED GO TO 00090013
13: C STATEMENT USING THE INTEGER VARIABLE AS THE BRANCH CONTROLLER 00100013
14: C IN A LIST OF POSSIBLE STATEMENT NUMBERS TO BE BRANCHED TO. 00110013
15: C 00120013
16: C REFERENCES 00130013
17: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140013
18: C X3.9-1978 00150013
19: C 00160013
20: C SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN) STATEMENT 00170013
21: C SECTION 11.3, ASSIGNED GO TO STATEMENT 00180013
22: C 00190013
23: C 00200013
24: C ********************************************************** 00210013
25: C 00220013
26: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00230013
27: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00240013
28: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250013
29: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00260013
30: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270013
31: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00280013
32: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00290013
33: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300013
34: C OF EXECUTING THESE TESTS. 00310013
35: C 00320013
36: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330013
37: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00340013
38: C 00350013
39: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00360013
40: C 00370013
41: C DEPARTMENT OF THE NAVY 00380013
42: C FEDERAL COBOL COMPILER TESTING SERVICE 00390013
43: C WASHINGTON, D.C. 20376 00400013
44: C 00410013
45: C ********************************************************** 00420013
46: C 00430013
47: C 00440013
48: C 00450013
49: C INITIALIZATION SECTION 00460013
50: C 00470013
51: C INITIALIZE CONSTANTS 00480013
52: C ************** 00490013
53: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00500013
54: I01 = 5 00510013
55: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00520013
56: I02 = 6 00530013
57: C SYSTEM ENVIRONMENT SECTION 00540013
58: C 00550013
59: I01 = 5 00560013
60: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00570013
61: C (UNIT NUMBER FOR CARD READER). 00580013
62: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590013
63: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00600013
64: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00610013
65: C 00620013
66: I02 = 6 00630013
67: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00640013
68: C (UNIT NUMBER FOR PRINTER). 00650013
69: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660013
70: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670013
71: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00680013
72: C 00690013
73: IVPASS=0 00700013
74: IVFAIL=0 00710013
75: IVDELE=0 00720013
76: ICZERO=0 00730013
77: C 00740013
78: C WRITE PAGE HEADERS 00750013
79: WRITE (I02,90000) 00760013
80: WRITE (I02,90001) 00770013
81: WRITE (I02,90002) 00780013
82: WRITE (I02, 90002) 00790013
83: WRITE (I02,90003) 00800013
84: WRITE (I02,90002) 00810013
85: WRITE (I02,90004) 00820013
86: WRITE (I02,90002) 00830013
87: WRITE (I02,90011) 00840013
88: WRITE (I02,90002) 00850013
89: WRITE (I02,90002) 00860013
90: WRITE (I02,90005) 00870013
91: WRITE (I02,90006) 00880013
92: WRITE (I02,90002) 00890013
93: IVTNUM = 126 00900013
94: C 00910013
95: C TEST 126 - THIS TESTS THE SIMPLE ASSIGN STATEMENT IN PREPARATION00920013
96: C FOR THE ASSIGNED GO TO TEST TO FOLLOW. 00930013
97: C THE ASSIGNED GO TO IS THE SIMPLIST FORM OF THE STATEMENT. 00940013
98: C 00950013
99: C 00960013
100: IF (ICZERO) 31260, 1260, 31260 00970013
101: 1260 CONTINUE 00980013
102: ASSIGN 1263 TO I 00990013
103: GO TO I, (1262,1263,1264) 01000013
104: 1262 ICON01 = 1262 01010013
105: GO TO 1265 01020013
106: 1263 ICON01 = 1263 01030013
107: GO TO 1265 01040013
108: 1264 ICON01 = 1264 01050013
109: 1265 CONTINUE 01060013
110: GO TO 41260 01070013
111: 31260 IVDELE = IVDELE + 1 01080013
112: WRITE (I02,80003) IVTNUM 01090013
113: IF (ICZERO) 41260, 1271, 41260 01100013
114: 41260 IF ( ICON01 - 1263 ) 21260, 11260, 21260 01110013
115: 11260 IVPASS = IVPASS + 1 01120013
116: WRITE (I02,80001) IVTNUM 01130013
117: GO TO 1271 01140013
118: 21260 IVFAIL = IVFAIL + 1 01150013
119: IVCOMP=ICON01 01160013
120: IVCORR = 1263 01170013
121: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01180013
122: 1271 CONTINUE 01190013
123: IVTNUM = 127 01200013
124: C 01210013
125: C TEST 127 - THIS IS A TEST OF MORE COMPLEX BRANCHING USING 01220013
126: C THE ASSIGN AND ASSIGNED GO TO STATEMENTS. THIS TEST IS NOT 01230013
127: C INTENDED TO BE AN EXAMPLE OF STRUCTURED PROGRAMMING. 01240013
128: C 01250013
129: C 01260013
130: IF (ICZERO) 31270, 1270, 31270 01270013
131: 1270 CONTINUE 01280013
132: IVON01=0 01290013
133: 1272 ASSIGN 1273 TO J 01300013
134: IVON01=IVON01+1 01310013
135: GO TO 1276 01320013
136: 1273 ASSIGN 1274 TO J 01330013
137: IVON01=IVON01 * 10 + 2 01340013
138: GO TO 1276 01350013
139: 1274 ASSIGN 1275 TO J 01360013
140: IVON01=IVON01 * 100 + 3 01370013
141: GO TO 1276 01380013
142: 1275 GO TO 1277 01390013
143: 1276 GO TO J, ( 1272, 1273, 1274, 1275 ) 01400013
144: 1277 CONTINUE 01410013
145: GO TO 41270 01420013
146: 31270 IVDELE = IVDELE + 1 01430013
147: WRITE (I02,80003) IVTNUM 01440013
148: IF (ICZERO) 41270, 1281, 41270 01450013
149: 41270 IF ( IVON01 - 1203 ) 21270, 11270, 21270 01460013
150: 11270 IVPASS = IVPASS + 1 01470013
151: WRITE (I02,80001) IVTNUM 01480013
152: GO TO 1281 01490013
153: 21270 IVFAIL = IVFAIL + 1 01500013
154: IVCOMP=IVON01 01510013
155: IVCORR=1203 01520013
156: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01530013
157: 1281 CONTINUE 01540013
158: IVTNUM = 128 01550013
159: C 01560013
160: C TEST 128 - TEST OF THE ASSIGNED GO TO WITH ALL OF THE 01570013
161: C STATEMENT NUMBERS IN THE ASSIGNED GO TO LIST THE SAME 01580013
162: C VALUE EXCEPT FOR ONE. 01590013
163: C 01600013
164: C 01610013
165: IF (ICZERO) 31280, 1280, 31280 01620013
166: 1280 CONTINUE 01630013
167: ICON01=0 01640013
168: ASSIGN 1283 TO K 01650013
169: GO TO K, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 ) 01660013
170: 1282 ICON01 = 0 01670013
171: GO TO 1284 01680013
172: 1283 ICON01 = 1 01690013
173: 1284 CONTINUE 01700013
174: GO TO 41280 01710013
175: 31280 IVDELE = IVDELE + 1 01720013
176: WRITE (I02,80003) IVTNUM 01730013
177: IF (ICZERO) 41280, 1291, 41280 01740013
178: 41280 IF ( ICON01 - 1 ) 21280, 11280, 21280 01750013
179: 11280 IVPASS = IVPASS + 1 01760013
180: WRITE (I02,80001) IVTNUM 01770013
181: GO TO 1291 01780013
182: 21280 IVFAIL = IVFAIL + 1 01790013
183: IVCOMP=ICON01 01800013
184: IVCORR=1 01810013
185: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01820013
186: 1291 CONTINUE 01830013
187: IVTNUM = 129 01840013
188: C 01850013
189: C TEST 129 - THIS TESTS THE ASSIGN STATEMENT IN CONJUNCTION 01860013
190: C WITH THE NORMAL ARITHMETIC ASSIGN STATEMENT. THE VALUE 01870013
191: C OF THE INDEX FOR THE ASSIGNED GO TO STATEMENT IS CHANGED BY 01880013
192: C THE COMBINATION OF STATEMENTS. 01890013
193: C 01900013
194: C 01910013
195: IF (ICZERO) 31290, 1290, 31290 01920013
196: 1290 CONTINUE 01930013
197: ICON01=0 01940013
198: ASSIGN 1292 TO L 01950013
199: L = 1293 01960013
200: ASSIGN 1294 TO L 01970013
201: GO TO L, ( 1294, 1293, 1292 ) 01980013
202: 1292 ICON01 = 0 01990013
203: GO TO 1295 02000013
204: 1293 ICON01 = 0 02010013
205: GO TO 1295 02020013
206: 1294 ICON01 = 1 02030013
207: 1295 CONTINUE 02040013
208: GO TO 41290 02050013
209: 31290 IVDELE = IVDELE + 1 02060013
210: WRITE (I02,80003) IVTNUM 02070013
211: IF (ICZERO) 41290, 1301, 41290 02080013
212: 41290 IF ( ICON01 - 1 ) 21290, 11290, 21290 02090013
213: 11290 IVPASS = IVPASS + 1 02100013
214: WRITE (I02,80001) IVTNUM 02110013
215: GO TO 1301 02120013
216: 21290 IVFAIL = IVFAIL + 1 02130013
217: IVCOMP=ICON01 02140013
218: IVCORR=1 02150013
219: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02160013
220: 1301 CONTINUE 02170013
221: IVTNUM = 130 02180013
222: C 02190013
223: C TEST 130 - THIS IS A TEST OF A LOOP USING A COMBINATION OF THE 02200013
224: C ASSIGNED GO TO STATEMENT AND THE ARITHMETIC IF STATEMENT. 02210013
225: C THE LOOP SHOULD BE EXECUTED ELEVEN (11) TIMES THEN CONTROL 02220013
226: C SHOULD PASS TO THE CHECK OF THE VALUE FOR IVON01. 02230013
227: C 02240013
228: C 02250013
229: IF (ICZERO) 31300, 1300, 31300 02260013
230: 1300 CONTINUE 02270013
231: IVON01=0 02280013
232: 1302 ASSIGN 1302 TO M 02290013
233: IVON01=IVON01+1 02300013
234: IF ( IVON01 - 10 ) 1303, 1303, 1304 02310013
235: 1303 GO TO 1305 02320013
236: 1304 ASSIGN 1306 TO M 02330013
237: 1305 GO TO M, ( 1302, 1306 ) 02340013
238: 1306 CONTINUE 02350013
239: GO TO 41300 02360013
240: 31300 IVDELE = IVDELE + 1 02370013
241: WRITE (I02,80003) IVTNUM 02380013
242: IF (ICZERO) 41300, 1311, 41300 02390013
243: 41300 IF ( IVON01 - 11 ) 21300, 11300, 21300 02400013
244: 11300 IVPASS = IVPASS + 1 02410013
245: WRITE (I02,80001) IVTNUM 02420013
246: GO TO 1311 02430013
247: 21300 IVFAIL = IVFAIL + 1 02440013
248: IVCOMP=IVON01 02450013
249: IVCORR=11 02460013
250: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02470013
251: 1311 CONTINUE 02480013
252: C 02490013
253: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02500013
254: 99999 CONTINUE 02510013
255: WRITE (I02,90002) 02520013
256: WRITE (I02,90006) 02530013
257: WRITE (I02,90002) 02540013
258: WRITE (I02,90002) 02550013
259: WRITE (I02,90007) 02560013
260: WRITE (I02,90002) 02570013
261: WRITE (I02,90008) IVFAIL 02580013
262: WRITE (I02,90009) IVPASS 02590013
263: WRITE (I02,90010) IVDELE 02600013
264: C 02610013
265: C 02620013
266: C TERMINATE ROUTINE EXECUTION 02630013
267: STOP 02640013
268: C 02650013
269: C FORMAT STATEMENTS FOR PAGE HEADERS 02660013
270: 90000 FORMAT (1H1) 02670013
271: 90002 FORMAT (1H ) 02680013
272: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02690013
273: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02700013
274: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02710013
275: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02720013
276: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02730013
277: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02740013
278: C 02750013
279: C FORMAT STATEMENTS FOR RUN SUMMARIES 02760013
280: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02770013
281: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02780013
282: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02790013
283: C 02800013
284: C FORMAT STATEMENTS FOR TEST RESULTS 02810013
285: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02820013
286: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02830013
287: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02840013
288: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02850013
289: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02860013
290: C 02870013
291: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM013) 02880013
292: END 02890013
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.