|
|
1.1 root 1: C COMMENT SECTION 00010028
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 00020028
6: C FM028 00030028
7: C 00040028
8: C THIS ROUTINE CONTAINS THE EXTERNAL FUNCTION REFERENCE TESTS. 00050028
9: C THE FUNCTION SUBPROGRAM FF029 IS CALLED BY THIS PROGRAM. THE 00060028
10: C FUNCTION SUBPROGRAM FF029 INCREMENTS THE CALLING ARGUMENT BY 1 00070028
11: C AND RETURNS TO THE CALLING PROGRAM. 00080028
12: C 00090028
13: C EXECUTION OF AN EXTERNAL FUNCTION REFERENCE RESULTS IN AN 00100028
14: C ASSOCIATION OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY 00110028
15: C ARGUMENTS IN THE DEFINING SUBPROGRAM. FOLLOWING THESE 00120028
16: C ASSOCIATIONS, EXECUTION OF THE FIRST EXECUTABLE STATEMENT OF THE 00130028
17: C DEFINING SUBPROGRAM IS UNDERTAKEN. 00140028
18: C 00150028
19: C REFERENCES 00160028
20: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00170028
21: C X3.9-1978 00180028
22: C 00190028
23: C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION 00200028
24: C 00210028
25: INTEGER FF029 00220028
26: C 00230028
27: C 00240028
28: C ********************************************************** 00250028
29: C 00260028
30: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00270028
31: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00280028
32: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00290028
33: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00300028
34: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00310028
35: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00320028
36: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00330028
37: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00340028
38: C OF EXECUTING THESE TESTS. 00350028
39: C 00360028
40: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00370028
41: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00380028
42: C 00390028
43: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00400028
44: C 00410028
45: C DEPARTMENT OF THE NAVY 00420028
46: C FEDERAL COBOL COMPILER TESTING SERVICE 00430028
47: C WASHINGTON, D.C. 20376 00440028
48: C 00450028
49: C ********************************************************** 00460028
50: C 00470028
51: C 00480028
52: C 00490028
53: C INITIALIZATION SECTION 00500028
54: C 00510028
55: C INITIALIZE CONSTANTS 00520028
56: C ************** 00530028
57: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00540028
58: I01 = 5 00550028
59: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00560028
60: I02 = 6 00570028
61: C SYSTEM ENVIRONMENT SECTION 00580028
62: C 00590028
63: I01 = 5 00600028
64: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00610028
65: C (UNIT NUMBER FOR CARD READER). 00620028
66: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00630028
67: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00640028
68: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00650028
69: C 00660028
70: I02 = 6 00670028
71: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00680028
72: C (UNIT NUMBER FOR PRINTER). 00690028
73: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00700028
74: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00710028
75: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00720028
76: C 00730028
77: IVPASS=0 00740028
78: IVFAIL=0 00750028
79: IVDELE=0 00760028
80: ICZERO=0 00770028
81: C 00780028
82: C WRITE PAGE HEADERS 00790028
83: WRITE (I02,90000) 00800028
84: WRITE (I02,90001) 00810028
85: WRITE (I02,90002) 00820028
86: WRITE (I02, 90002) 00830028
87: WRITE (I02,90003) 00840028
88: WRITE (I02,90002) 00850028
89: WRITE (I02,90004) 00860028
90: WRITE (I02,90002) 00870028
91: WRITE (I02,90011) 00880028
92: WRITE (I02,90002) 00890028
93: WRITE (I02,90002) 00900028
94: WRITE (I02,90005) 00910028
95: WRITE (I02,90006) 00920028
96: WRITE (I02,90002) 00930028
97: C 00940028
98: C TEST SECTION 00950028
99: C 00960028
100: C EXTERNAL FUNCTION REFERENCE 00970028
101: C 00980028
102: C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS SUBPROGRAM 00990028
103: C ARGUMENT NAME. 01000028
104: 6701 CONTINUE 01010028
105: IVTNUM = 670 01020028
106: C 01030028
107: C **** TEST 670 **** 01040028
108: C 01050028
109: IF (ICZERO) 36700,6700,36700 01060028
110: 6700 CONTINUE 01070028
111: IVON01 = 0 01080028
112: IVCOMP = FF029(IVON01) 01090028
113: GO TO 46700 01100028
114: 36700 IVDELE = IVDELE + 1 01110028
115: WRITE (I02,80003) IVTNUM 01120028
116: IF (ICZERO) 46700,6711,46700 01130028
117: 46700 IF (IVCOMP - 1) 26700,16700,26700 01140028
118: 16700 IVPASS = IVPASS + 1 01150028
119: WRITE (I02,80001) IVTNUM 01160028
120: GO TO 6711 01170028
121: 26700 IVFAIL = IVFAIL + 1 01180028
122: IVCORR = 1 01190028
123: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01200028
124: 6711 CONTINUE 01210028
125: IVTNUM = 671 01220028
126: C 01230028
127: C **** TEST 671 **** 01240028
128: C 01250028
129: C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS INTERNAL 01260028
130: C VARIABLE IN FUNCTION SUBPROGRAM. 01270028
131: C 01280028
132: IF (ICZERO) 36710,6710,36710 01290028
133: 6710 CONTINUE 01300028
134: IVON02 = 2 01310028
135: IVON01 = 5 01320028
136: IVCOMP = FF029(IVON02) 01330028
137: GO TO 46710 01340028
138: 36710 IVDELE = IVDELE + 1 01350028
139: WRITE (I02,80003) IVTNUM 01360028
140: IF (ICZERO) 46710,6721,46710 01370028
141: 46710 IF (IVCOMP - 3) 26710,16710,26710 01380028
142: 16710 IVPASS = IVPASS + 1 01390028
143: WRITE (I02,80001) IVTNUM 01400028
144: GO TO 6721 01410028
145: 26710 IVFAIL = IVFAIL + 1 01420028
146: IVCORR = 3 01430028
147: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01440028
148: 6721 CONTINUE 01450028
149: IVTNUM = 672 01460028
150: C 01470028
151: C **** TEST 672 **** 01480028
152: C 01490028
153: C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME DIFFERENT FROM 01500028
154: C FUNCTION SUBPROGRAM ARGUMENT AND INTERNAL VARIABLE. 01510028
155: C 01520028
156: IF (ICZERO) 36720,6720,36720 01530028
157: 6720 CONTINUE 01540028
158: IVON01 = 7 01550028
159: IVON03 = -12 01560028
160: IVCOMP = FF029(IVON03) 01570028
161: GO TO 46720 01580028
162: 36720 IVDELE = IVDELE + 1 01590028
163: WRITE (I02,80003) IVTNUM 01600028
164: IF (ICZERO) 46720,6731,46720 01610028
165: 46720 IF (IVCOMP + 11) 26720,16720,26720 01620028
166: 16720 IVPASS = IVPASS + 1 01630028
167: WRITE (I02,80001) IVTNUM 01640028
168: GO TO 6731 01650028
169: 26720 IVFAIL = IVFAIL + 1 01660028
170: IVCORR = -11 01670028
171: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01680028
172: 6731 CONTINUE 01690028
173: IVTNUM = 673 01700028
174: C 01710028
175: C **** TEST 673 **** 01720028
176: C 01730028
177: C REPEATED EXTERNAL FUNCTION REFERENCE IN A DO LOOP. 01740028
178: C 01750028
179: IF (ICZERO) 36730,6730,36730 01760028
180: 6730 CONTINUE 01770028
181: IVON01 = -7 01780028
182: IVCOMP = 0 01790028
183: DO 6732 IVON04 = 1,5 01800028
184: IVCOMP = FF029(IVCOMP) 01810028
185: 6732 CONTINUE 01820028
186: GO TO 46730 01830028
187: 36730 IVDELE = IVDELE + 1 01840028
188: WRITE (I02,80003) IVTNUM 01850028
189: IF (ICZERO) 46730,6741,46730 01860028
190: 46730 IF (IVCOMP - 5) 26730,16730,26730 01870028
191: 16730 IVPASS = IVPASS + 1 01880028
192: WRITE (I02,80001) IVTNUM 01890028
193: GO TO 6741 01900028
194: 26730 IVFAIL = IVFAIL + 1 01910028
195: IVCORR = 5 01920028
196: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01930028
197: 6741 CONTINUE 01940028
198: C 01950028
199: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 01960028
200: 99999 CONTINUE 01970028
201: WRITE (I02,90002) 01980028
202: WRITE (I02,90006) 01990028
203: WRITE (I02,90002) 02000028
204: WRITE (I02,90002) 02010028
205: WRITE (I02,90007) 02020028
206: WRITE (I02,90002) 02030028
207: WRITE (I02,90008) IVFAIL 02040028
208: WRITE (I02,90009) IVPASS 02050028
209: WRITE (I02,90010) IVDELE 02060028
210: C 02070028
211: C 02080028
212: C TERMINATE ROUTINE EXECUTION 02090028
213: STOP 02100028
214: C 02110028
215: C FORMAT STATEMENTS FOR PAGE HEADERS 02120028
216: 90000 FORMAT (1H1) 02130028
217: 90002 FORMAT (1H ) 02140028
218: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02150028
219: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02160028
220: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02170028
221: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02180028
222: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02190028
223: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02200028
224: C 02210028
225: C FORMAT STATEMENTS FOR RUN SUMMARIES 02220028
226: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02230028
227: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02240028
228: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02250028
229: C 02260028
230: C FORMAT STATEMENTS FOR TEST RESULTS 02270028
231: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02280028
232: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02290028
233: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02300028
234: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02310028
235: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02320028
236: C 02330028
237: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM028) 02340028
238: END 02350028
239: INTEGER FUNCTION FF029(IVON01) 00010029
240: C DATE***82/08/02*18.33.46
241: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
242: C AUDIT FCVS78 V2.0
243: C 00020029
244: C COMMENT SECTION 00030029
245: C FF029 00040029
246: C 00050029
247: C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM028. 00060029
248: C THE FUNCTION ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED 00070029
249: C TO THE CALLING PROGRAM. 00080029
250: C 00090029
251: C REFERENCES 00100029
252: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110029
253: C X3.9-1978 00120029
254: C 00130029
255: C SECTION 15.5.1, DEFINING FUNCTION SUBPROGRAMS AND FUNCTION 00140029
256: C STATEMENTS 00150029
257: C SECTION 15.8, RETURN STATEMENT 00160029
258: C 00170029
259: C TEST SECTION 00180029
260: C 00190029
261: C FUNCTION SUBPROGRAM 00200029
262: C 00210029
263: C INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM. 00220029
264: C 00230029
265: IVON02 = IVON01 00240029
266: FF029 = IVON02 + 1 00250029
267: IVON02 = 500 00260029
268: RETURN 00270029
269: END 00280029
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.