|
|
1.1 root 1: PROGRAM FM517 00010517
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 00020517
6: C THIS PROGRAM TESTS THE RETURN STATEMENT ANS REF. 00030517
7: C RETURN E 15.8.1 00040517
8: C IN SUBROUTINE SUBPROGRAMS. E IS AN ARITHMETIC 15.8.3 00050517
9: C EXPRESSION WHOSE VALUE INDICATES WHERE CONTROL 00060517
10: C WILL BE RETURNED TO. 00070517
11: C 00080517
12: C THIS ROUTINE USES SUBROUTINE SUBPROGRAMS SN518 00090517
13: C AND SN519 00100517
14: C 00110517
15: CBB** ********************** BBCCOMNT **********************************00120517
16: C**** 00130517
17: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140517
18: C**** VERSION 2.0 00150517
19: C**** 00160517
20: C**** 00170517
21: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180517
22: C**** GENERAL SERVICES ADMINISTRATION 00190517
23: C**** FEDERAL SOFTWARE TESTING CENTER 00200517
24: C**** 5203 LEESBURG PIKE, SUITE 1100 00210517
25: C**** FALLS CHURCH, VA. 22041 00220517
26: C**** 00230517
27: C**** (703) 756-6153 00240517
28: C**** 00250517
29: CBE** ********************** BBCCOMNT **********************************00260517
30: IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00270517
31: IMPLICIT CHARACTER*27 (C) 00280517
32: CBB** ********************** BBCINITA **********************************00290517
33: C**** SPECIFICATION STATEMENTS 00300517
34: C**** 00310517
35: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320517
36: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330517
37: CBE** ********************** BBCINITA **********************************00340517
38: C 00350517
39: 00360517
40: C 00370517
41: C 00380517
42: CBB** ********************** BBCINITB **********************************00390517
43: C**** INITIALIZE SECTION 00400517
44: DATA ZVERS, ZVERSD, ZDATE 00410517
45: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00420517
46: DATA ZCOMPL, ZNAME, ZTAPE 00430517
47: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00440517
48: DATA ZPROJ, ZTAPED, ZPROG 00450517
49: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00460517
50: DATA REMRKS /' '/ 00470517
51: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00480517
52: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00490517
53: C**** 00500517
54: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00510517
55: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00520517
56: CZ03 ZPROG = 'PROGRAM NAME' 00530517
57: ZDATE = '07-Nov-85 ' *RP
58: ZCOMPL = 'CCI 5.2 ' *RP
59: ZPROJ = 'TC-85- -410' *RP
60: ZNAME = ' ' *RP
61: ZTAPE = ' ' *RP
62: ZTAPED = '850703 ' *RP
63: C 00600517
64: IVPASS = 0 00610517
65: IVFAIL = 0 00620517
66: IVDELE = 0 00630517
67: IVINSP = 0 00640517
68: IVTOTL = 0 00650517
69: IVTOTN = 0 00660517
70: ICZERO = 0 00670517
71: C 00680517
72: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00690517
73: I01 = 05 00700517
74: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00710517
75: I02 = 06 00720517
76: C 00730517
77: I01 = 5 00740517
78: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750517
79: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00760517
80: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00770517
81: C 00780517
82: I02 = 6 00790517
83: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00800517
84: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00810517
85: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00820517
86: C 00830517
87: CBE** ********************** BBCINITB **********************************00840517
88: ZPROG = 'FM517' 00850517
89: IVTOTL = 5 00860517
90: CBB** ********************** BBCHED0A **********************************00870517
91: C**** 00880517
92: C**** WRITE REPORT TITLE 00890517
93: C**** 00900517
94: WRITE (I02, 90002) 00910517
95: WRITE (I02, 90006) 00920517
96: WRITE (I02, 90007) 00930517
97: WRITE (I02, 90008) ZVERS, ZVERSD 00940517
98: WRITE (I02, 90009) ZPROG, ZPROG 00950517
99: WRITE (I02, 90010) ZDATE, ZCOMPL 00960517
100: CBE** ********************** BBCHED0A **********************************00970517
101: CBB** ********************** BBCHED0B **********************************00980517
102: C**** WRITE DETAIL REPORT HEADERS 00990517
103: C**** 01000517
104: WRITE (I02,90004) 01010517
105: WRITE (I02,90004) 01020517
106: WRITE (I02,90013) 01030517
107: WRITE (I02,90014) 01040517
108: WRITE (I02,90015) IVTOTL 01050517
109: CBE** ********************** BBCHED0B **********************************01060517
110: C TESTS 1 AND 2 TEST RETURN CONTROL PROCESSING IN THE EXECUTION 01070517
111: C OF A SUBROUTINE SUBPROGRAM WHICH PROVIDES ALTERNATE RETURN 01080517
112: C 01090517
113: CT001* TEST 001 **** FCVS PROGRAM 517 **** 01100517
114: C 01110517
115: IVTNUM = 1 01120517
116: IVCOMP = 0 01130517
117: IVCORR = 3 01140517
118: IVN001 = 2 01150517
119: CALL SN518(IVN001,*0012,*0013) 01160517
120: IVCOMP = 1 01170517
121: GO TO 0014 01180517
122: 0012 CONTINUE 01190517
123: IVCOMP = 2 01200517
124: GO TO 0014 01210517
125: 0013 CONTINUE 01220517
126: IVCOMP = 3 01230517
127: 0014 CONTINUE 01240517
128: 40010 IF (IVCOMP - 3) 20010, 10010, 20010 01250517
129: 10010 IVPASS = IVPASS + 1 01260517
130: WRITE (I02,80002) IVTNUM 01270517
131: GO TO 0011 01280517
132: 20010 IVFAIL = IVFAIL + 1 01290517
133: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300517
134: 0011 CONTINUE 01310517
135: C 01320517
136: CT002* TEST 002 **** FCVS PROGRAM 517 **** 01330517
137: C 01340517
138: IVTNUM = 2 01350517
139: IVCOMP = 0 01360517
140: IVCORR = 5 01370517
141: CALL SN519(7,*0022,*0023) 01380517
142: IVCOMP = 1 01390517
143: GO TO 0024 01400517
144: 0022 CONTINUE 01410517
145: IVCOMP = 3 01420517
146: GO TO 0024 01430517
147: 0023 CONTINUE 01440517
148: IVCOMP = 5 01450517
149: 0024 CONTINUE 01460517
150: 40020 IF (IVCOMP - 5) 20020, 10020, 20020 01470517
151: 10020 IVPASS = IVPASS + 1 01480517
152: WRITE (I02,80002) IVTNUM 01490517
153: GO TO 0021 01500517
154: 20020 IVFAIL = IVFAIL + 1 01510517
155: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01520517
156: 0021 CONTINUE 01530517
157: C 01540517
158: CT003* TEST 003 **** FCVS PROGRAM 517 **** 01550517
159: C TEST 003 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 01560517
160: C LESS THAN ONE 01570517
161: C 01580517
162: IVTNUM = 3 01590517
163: IVCOMP = 0 01600517
164: IVCORR = -2 01610517
165: CALL SN518(-3,*0032,*0033) 01620517
166: IVCOMP = -2 01630517
167: GO TO 0034 01640517
168: 0032 CONTINUE 01650517
169: IVCOMP = -4 01660517
170: GO TO 0034 01670517
171: 0033 CONTINUE 01680517
172: IVCOMP = -6 01690517
173: 0034 CONTINUE 01700517
174: 40030 IF (IVCOMP + 2) 20030, 10030, 20030 01710517
175: 10030 IVPASS = IVPASS + 1 01720517
176: WRITE (I02,80002) IVTNUM 01730517
177: GO TO 0031 01740517
178: 20030 IVFAIL = IVFAIL + 1 01750517
179: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01760517
180: 0031 CONTINUE 01770517
181: C 01780517
182: CT004* TEST 004 **** FCVS PROGRAM 517 **** 01790517
183: C TEST 004 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 01800517
184: C GREATER THAN THE NUMBER OF ASTERISKS IN A SUBROUTINE STATEMENT 01810517
185: C 01820517
186: IVTNUM = 4 01830517
187: IVCOMP = 0 01840517
188: IVCORR = 7 01850517
189: CALL SN518(3,*0042,*0043) 01860517
190: IVCOMP = 7 01870517
191: GO TO 0044 01880517
192: 0042 CONTINUE 01890517
193: IVCOMP = 9 01900517
194: GO TO 0044 01910517
195: 0043 CONTINUE 01920517
196: IVCOMP = 11 01930517
197: 0044 CONTINUE 01940517
198: 40040 IF (IVCOMP - 7) 20040, 10040, 20040 01950517
199: 10040 IVPASS = IVPASS + 1 01960517
200: WRITE (I02,80002) IVTNUM 01970517
201: GO TO 0041 01980517
202: 20040 IVFAIL = IVFAIL + 1 01990517
203: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02000517
204: 0041 CONTINUE 02010517
205: C 02020517
206: CT005* TEST 005 **** FCVS PROGRAM 517 **** 02030517
207: C TEST 005 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 02040517
208: C GREATER THAN THE NUMBER OF ASTERISKS IN AN ENTRY STATEMENT 02050517
209: C 02060517
210: IVTNUM = 5 02070517
211: IVCOMP = 0 02080517
212: IVCORR = -10 02090517
213: CALL EN872(9,*0052,*0053) 02100517
214: IVCOMP = -10 02110517
215: GO TO 0054 02120517
216: 0052 CONTINUE 02130517
217: IVCOMP = 3 02140517
218: GO TO 0054 02150517
219: 0053 CONTINUE 02160517
220: IVCOMP = 11 02170517
221: 0054 CONTINUE 02180517
222: 40050 IF (IVCOMP + 10) 20050, 10050, 20050 02190517
223: 10050 IVPASS = IVPASS + 1 02200517
224: WRITE (I02,80002) IVTNUM 02210517
225: GO TO 0051 02220517
226: 20050 IVFAIL = IVFAIL + 1 02230517
227: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02240517
228: 0051 CONTINUE 02250517
229: C 02260517
230: CBB** ********************** BBCSUM0 **********************************02270517
231: C**** WRITE OUT TEST SUMMARY 02280517
232: C**** 02290517
233: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02300517
234: WRITE (I02, 90004) 02310517
235: WRITE (I02, 90014) 02320517
236: WRITE (I02, 90004) 02330517
237: WRITE (I02, 90020) IVPASS 02340517
238: WRITE (I02, 90022) IVFAIL 02350517
239: WRITE (I02, 90024) IVDELE 02360517
240: WRITE (I02, 90026) IVINSP 02370517
241: WRITE (I02, 90028) IVTOTN, IVTOTL 02380517
242: CBE** ********************** BBCSUM0 **********************************02390517
243: CBB** ********************** BBCFOOT0 **********************************02400517
244: C**** WRITE OUT REPORT FOOTINGS 02410517
245: C**** 02420517
246: WRITE (I02,90016) ZPROG, ZPROG 02430517
247: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02440517
248: WRITE (I02,90019) 02450517
249: CBE** ********************** BBCFOOT0 **********************************02460517
250: 90001 FORMAT (1H ,56X,5HFM517) 02470517
251: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM517) 02480517
252: CBB** ********************** BBCFMT0A **********************************02490517
253: C**** FORMATS FOR TEST DETAIL LINES 02500517
254: C**** 02510517
255: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 02520517
256: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 02530517
257: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 02540517
258: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 02550517
259: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 02560517
260: 1I6,/,1H ,15X,10HCORRECT= ,I6) 02570517
261: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02580517
262: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 02590517
263: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02600517
264: 1A21,/,1H ,16X,10HCORRECT= ,A21) 02610517
265: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 02620517
266: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 02630517
267: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 02640517
268: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 02650517
269: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 02660517
270: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 02670517
271: 80050 FORMAT (1H ,48X,A31) 02680517
272: CBE** ********************** BBCFMT0A **********************************02690517
273: CBB** ********************** BBCFMAT1 **********************************02700517
274: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02710517
275: C**** 02720517
276: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02730517
277: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 02740517
278: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 02750517
279: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 02760517
280: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 02770517
281: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 02780517
282: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 02790517
283: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 02800517
284: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02810517
285: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 02820517
286: 21H(,F12.5,2H, ,F12.5,1H)) 02830517
287: CBE** ********************** BBCFMAT1 **********************************02840517
288: CBB** ********************** BBCFMT0B **********************************02850517
289: C**** FORMAT STATEMENTS FOR PAGE HEADERS 02860517
290: C**** 02870517
291: 90002 FORMAT (1H1) 02880517
292: 90004 FORMAT (1H ) 02890517
293: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 02900517
294: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02910517
295: 90008 FORMAT (1H ,21X,A13,A17) 02920517
296: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 02930517
297: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 02940517
298: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 02950517
299: 1 7X,7HREMARKS,24X) 02960517
300: 90014 FORMAT (1H ,46H----------------------------------------------, 02970517
301: 1 33H---------------------------------) 02980517
302: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 02990517
303: C**** 03000517
304: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03010517
305: C**** 03020517
306: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 03030517
307: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 03040517
308: 1 A13) 03050517
309: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 03060517
310: C**** 03070517
311: C**** FORMAT STATEMENTS FOR RUN SUMMARY 03080517
312: C**** 03090517
313: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 03100517
314: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 03110517
315: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 03120517
316: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 03130517
317: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 03140517
318: CBE** ********************** BBCFMT0B **********************************03150517
319: STOP 03160517
320: END 03170517
321: C 00010518
322: C DATE***82/08/02*18.33.46
323: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
324: C AUDIT FCVS78 V2.0
325: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 517 00020518
326: C 00030518
327: C THIS SUBROUTINE TESTS THE USE OF THE "RETURN E" STATEMENT 00040518
328: C WHERE E IS AN INTEGER VARIABLE 00050518
329: C 00060518
330: SUBROUTINE SN518(IVD001,*,*) 00070518
331: RETURN IVD001 00080518
332: END 00090518
333: C 00010519
334: C DATE***82/08/02*18.33.46
335: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
336: C AUDIT FCVS78 V2.0
337: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 517 00020519
338: C 00030519
339: C THIS SUBROUTINE TESTS THE USE OF THE "RETURN E" STATEMENT 00040519
340: C WHERE E IS AN INTEGER EXPRESSION 00050519
341: C 00060519
342: SUBROUTINE SN519(IVD001,*,*) 00070519
343: RETURN (IVD001 - 2*(IVD001/2) + 1) 00080519
344: ENTRY EN872(IVD002,*,*) 00090519
345: RETURN (IVD002 - 3) 00100519
346: END 00110519
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.