![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm056.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests|
Return to fm056.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 root 1: c
2: c comment section
3: c
4: c fm056
5: c
6: c fm056 is a main which tests the argument passing linkage of
7: c a 2 level nested subroutine and an external function reference.
8: c the main program fm056 calls subroutine fs057 passing one
9: c argument. subroutine fs057 calls subroutine fs058 passing two
10: c arguments. subroutine fs058 references external function ff059
11: c passing 3 arguments. function ff059 adds the values of the 3
12: c arguments together. subroutine fs057 and fs058 then merely
13: c return the result to fm056 in the first argument.
14: c
15: c the values of the arguments that are passed to each
16: c subprogram and function, and returned to the calling or
17: c referencing program are saved in an integer array. fm056 then
18: c uses these values to test the compiler's argument passing
19: c capabilities.
20: c
21: c references
22: c american national standard programming language fortran,
23: c x3.9-1978
24: c
25: c section 15.6.2, subroutine reference
26: common iacn11 (12)
27: c
28: c **********************************************************
29: c
30: c a compiler validation system for the fortran language
31: c based on specifications as defined in american national standard
32: c programming language fortran x3.9-1978, has been developed by the
33: c federal cobol compiler testing service. the fortran compiler
34: c validation system (fcvs) consists of audit routines, their related
35: c data, and an executive system. each audit routine is a fortran
36: c program, subprogram or function which includes tests of specific
37: c language elements and supporting procedures indicating the result
38: c of executing these tests.
39: c
40: c this particular program/subprogram/function contains features
41: c found only in the subset as defined in x3.9-1978.
42: c
43: c suggestions and comments should be forwarded to -
44: c
45: c department of the navy
46: c federal cobol compiler testing service
47: c washington, d.c. 20376
48: c
49: c **********************************************************
50: c
51: c
52: c
53: c initialization section
54: c
55: c initialize constants
56: c **************
57: c i01 contains the logical unit number for the card reader.
58: i01 = 5
59: c i02 contains the logical unit number for the printer.
60: i02 = 6
61: c system environment section
62: c
63: cx010 this card is replaced by contents of fexec x-010 control card.
64: c the cx010 card is for overriding the program default i01 = 5
65: c (unit number for card reader).
66: cx011 this card is replaced by contents of fexec x-011 control card.
67: c the cx011 card is for systems which require additional
68: c fortran statements for files associated with cx010 above.
69: c
70: cx020 this card is replaced by contents of fexec x-020 control card.
71: c the cx020 card is for overriding the program default i02 = 6
72: c (unit number for printer).
73: cx021 this card is replaced by contents of fexec x-021 control card.
74: c the cx021 card is for systems which require additional
75: c fortran statements for files associated with cx020 above.
76: c
77: ivpass=0
78: ivfail=0
79: ivdele=0
80: iczero=0
81: c
82: c write page headers
83: write (i02,90000)
84: write (i02,90001)
85: write (i02,90002)
86: write (i02, 90002)
87: write (i02,90003)
88: write (i02,90002)
89: write (i02,90004)
90: write (i02,90002)
91: write (i02,90011)
92: write (i02,90002)
93: write (i02,90002)
94: write (i02,90005)
95: write (i02,90006)
96: write (i02,90002)
97: c
98: c test section
99: c
100: c subroutine subprogram
101: c
102: ivon01 = 5
103: call fs057 (ivon01)
104: iacn11 (12) = ivon01
105: ivtnum = 430
106: c
107: c **** test 430 ****
108: c
109: c test 430 tests the value of the argument received by fs057 from
110: c a fm056 call to fs057
111: c
112: if (iczero) 34300, 4300, 34300
113: 4300 continue
114: ivcomp = iacn11 (1)
115: go to 44300
116: 34300 ivdele = ivdele + 1
117: write (i02,80003) ivtnum
118: if (iczero) 44300, 4311, 44300
119: 44300 if (ivcomp - 5) 24300,14300,24300
120: 14300 ivpass = ivpass + 1
121: write (i02,80001) ivtnum
122: go to 4311
123: 24300 ivfail = ivfail + 1
124: ivcorr = 5
125: write (i02,80004) ivtnum, ivcomp ,ivcorr
126: 4311 continue
127: ivtnum = 431
128: c
129: c **** test 431 ****
130: c
131: c test 431 tests the value of the second argument that was passed
132: c from a fs057 call to fs058
133: c
134: c
135: if (iczero) 34310, 4310, 34310
136: 4310 continue
137: ivcomp = iacn11 (2)
138: go to 44310
139: 34310 ivdele = ivdele + 1
140: write (i02,80003) ivtnum
141: if (iczero) 44310, 4321, 44310
142: 44310 if (ivcomp - 4) 24310,14310,24310
143: 14310 ivpass = ivpass + 1
144: write (i02,80001) ivtnum
145: go to 4321
146: 24310 ivfail = ivfail + 1
147: ivcorr = 4
148: write (i02,80004) ivtnum, ivcomp ,ivcorr
149: 4321 continue
150: ivtnum = 432
151: c
152: c **** test 432 ****
153: c
154: c test 432 tests the value of the first argument received by fs058
155: c from a fs057 call to fs058
156: c
157: c
158: if (iczero) 34320, 4320, 34320
159: 4320 continue
160: ivcomp = iacn11 (3)
161: go to 44320
162: 34320 ivdele = ivdele + 1
163: write (i02,80003) ivtnum
164: if (iczero) 44320, 4331, 44320
165: 44320 if (ivcomp - 5) 24320,14320,24320
166: 14320 ivpass = ivpass + 1
167: write (i02,80001) ivtnum
168: go to 4331
169: 24320 ivfail = ivfail + 1
170: ivcorr = 5
171: write (i02,80004) ivtnum, ivcomp ,ivcorr
172: 4331 continue
173: ivtnum = 433
174: c
175: c **** test 433 ****
176: c
177: c test 433 tests the value of the second argument received by fs058
178: c from a fs057 call to fs058
179: c
180: c
181: if (iczero) 34330, 4330, 34330
182: 4330 continue
183: ivcomp = iacn11 (4)
184: go to 44330
185: 34330 ivdele = ivdele + 1
186: write (i02,80003) ivtnum
187: if (iczero) 44330, 4341, 44330
188: 44330 if (ivcomp - 4) 24330,14330,24330
189: 14330 ivpass = ivpass + 1
190: write (i02,80001) ivtnum
191: go to 4341
192: 24330 ivfail = ivfail + 1
193: ivcorr = 4
194: write (i02,80004) ivtnum, ivcomp ,ivcorr
195: 4341 continue
196: ivtnum = 434
197: c
198: c **** test 434 ****
199: c
200: c test 434 tests the value of the third argument that was passed
201: c from a fs058 reference of function ff059
202: c
203: c
204: if (iczero) 34340, 4340, 34340
205: 4340 continue
206: ivcomp = iacn11 (5)
207: go to 44340
208: 34340 ivdele = ivdele + 1
209: write (i02,80003) ivtnum
210: if (iczero) 44340, 4351, 44340
211: 44340 if (ivcomp - 3) 24340,14340,24340
212: 14340 ivpass = ivpass + 1
213: write (i02,80001) ivtnum
214: go to 4351
215: 24340 ivfail = ivfail + 1
216: ivcorr = 3
217: write (i02,80004) ivtnum, ivcomp ,ivcorr
218: 4351 continue
219: ivtnum = 435
220: c
221: c **** test 435 ****
222: c
223: c test 435 tests the value of the first argument received by ff059
224: c from a fs058 reference of function ff059
225: c
226: c
227: if (iczero) 34350, 4350, 34350
228: 4350 continue
229: ivcomp = iacn11 (6)
230: go to 44350
231: 34350 ivdele = ivdele + 1
232: write (i02,80003) ivtnum
233: if (iczero) 44350, 4361, 44350
234: 44350 if (ivcomp - 5) 24350,14350,24350
235: 14350 ivpass = ivpass + 1
236: write (i02,80001) ivtnum
237: go to 4361
238: 24350 ivfail = ivfail + 1
239: ivcorr = 5
240: write (i02,80004) ivtnum, ivcomp ,ivcorr
241: 4361 continue
242: ivtnum = 436
243: c
244: c **** test 436 ****
245: c
246: c test 436 tests the value of the second argument received by ff059
247: c from a fs058 reference of function ff059
248: c
249: c
250: if (iczero) 34360, 4360, 34360
251: 4360 continue
252: ivcomp = iacn11 (7)
253: go to 44360
254: 34360 ivdele = ivdele + 1
255: write (i02,80003) ivtnum
256: if (iczero) 44360, 4371, 44360
257: 44360 if (ivcomp - 4) 24360,14360,24360
258: 14360 ivpass = ivpass + 1
259: write (i02,80001) ivtnum
260: go to 4371
261: 24360 ivfail = ivfail + 1
262: ivcorr = 4
263: write (i02,80004) ivtnum, ivcomp ,ivcorr
264: 4371 continue
265: ivtnum = 437
266: c
267: c **** test 437 ****
268: c
269: c test 437 tests the value of the third argument received by ff059
270: c from a fs058 reference of function ff059
271: c
272: c
273: if (iczero) 34370, 4370, 34370
274: 4370 continue
275: ivcomp = iacn11 (8)
276: go to 44370
277: 34370 ivdele = ivdele + 1
278: write (i02,80003) ivtnum
279: if (iczero) 44370, 4381, 44370
280: 44370 if (ivcomp - 3) 24370,14370,24370
281: 14370 ivpass = ivpass + 1
282: write (i02,80001) ivtnum
283: go to 4381
284: 24370 ivfail = ivfail + 1
285: ivcorr = 3
286: write (i02,80004) ivtnum, ivcomp ,ivcorr
287: 4381 continue
288: ivtnum = 438
289: c
290: c **** test 438 ****
291: c
292: c test 438 tests the value of the function determined by ff059
293: c
294: c
295: if (iczero) 34380, 4380, 34380
296: 4380 continue
297: ivcomp = iacn11 (9)
298: go to 44380
299: 34380 ivdele = ivdele + 1
300: write (i02,80003) ivtnum
301: if (iczero) 44380, 4391, 44380
302: 44380 if (ivcomp - 12) 24380,14380,24380
303: 14380 ivpass = ivpass + 1
304: write (i02,80001) ivtnum
305: go to 4391
306: 24380 ivfail = ivfail + 1
307: ivcorr = 12
308: write (i02,80004) ivtnum, ivcomp ,ivcorr
309: 4391 continue
310: ivtnum = 439
311: c
312: c **** test 439 ****
313: c
314: c test 439 tests the value of the function returned to fs058 by
315: c ff059
316: c
317: c
318: if (iczero) 34390, 4390, 34390
319: 4390 continue
320: ivcomp = iacn11 (10)
321: go to 44390
322: 34390 ivdele = ivdele + 1
323: write (i02,80003) ivtnum
324: if (iczero) 44390, 4401, 44390
325: 44390 if (ivcomp - 12) 24390,14390,24390
326: 14390 ivpass = ivpass + 1
327: write (i02,80001) ivtnum
328: go to 4401
329: 24390 ivfail = ivfail + 1
330: ivcorr = 12
331: write (i02,80004) ivtnum, ivcomp ,ivcorr
332: 4401 continue
333: ivtnum = 440
334: c
335: c **** test 440 ****
336: c
337: c test 440 tests the value of the first argument returned to fs057
338: c by fs058
339: c
340: if (iczero) 34400, 4400, 34400
341: 4400 continue
342: ivcomp = iacn11 (11)
343: go to 44400
344: 34400 ivdele = ivdele + 1
345: write (i02,80003) ivtnum
346: if (iczero) 44400, 4411, 44400
347: 44400 if (ivcomp - 12) 24400,14400,24400
348: 14400 ivpass = ivpass + 1
349: write (i02,80001) ivtnum
350: go to 4411
351: 24400 ivfail = ivfail + 1
352: ivcorr = 12
353: write (i02,80004) ivtnum, ivcomp ,ivcorr
354: 4411 continue
355: ivtnum = 441
356: c
357: c **** test 441 ****
358: c
359: c test 441 tests the value of the first argument returned to fm056
360: c by fs057
361: c
362: c
363: if (iczero) 34410, 4410, 34410
364: 4410 continue
365: ivcomp = iacn11 (12)
366: go to 44410
367: 34410 ivdele = ivdele + 1
368: write (i02,80003) ivtnum
369: if (iczero) 44410, 4421, 44410
370: 44410 if (ivcomp - 12) 24410,14410,24410
371: 14410 ivpass = ivpass + 1
372: write (i02,80001) ivtnum
373: go to 4421
374: 24410 ivfail = ivfail + 1
375: ivcorr = 12
376: write (i02,80004) ivtnum, ivcomp ,ivcorr
377: 4421 continue
378: c
379: c write page footings and run summaries
380: 99999 continue
381: write (i02,90002)
382: write (i02,90006)
383: write (i02,90002)
384: write (i02,90002)
385: write (i02,90007)
386: write (i02,90002)
387: write (i02,90008) ivfail
388: write (i02,90009) ivpass
389: write (i02,90010) ivdele
390: c
391: c
392: c terminate routine execution
393: stop
394: c
395: c format statements for page headers
396: 90000 format (1h1)
397: 90002 format (1h )
398: 90001 format (1h ,10x,34hfortran compiler validation system)
399: 90003 format (1h ,21x,11hversion 1.0)
400: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
401: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
402: 90006 format (1h ,5x,46h----------------------------------------------)
403: 90011 format (1h ,18x,17hsubset level test)
404: c
405: c format statements for run summaries
406: 90008 format (1h ,15x,i5,19h errors encountered)
407: 90009 format (1h ,15x,i5,13h tests passed)
408: 90010 format (1h ,15x,i5,14h tests deleted)
409: c
410: c format statements for test results
411: 80001 format (1h ,4x,i5,7x,4hpass)
412: 80002 format (1h ,4x,i5,7x,4hfail)
413: 80003 format (1h ,4x,i5,7x,7hdeleted)
414: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
415: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
416: c
417: 90007 format (1h ,20x,20hend of program fm056)
418: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.