|
|
1.1 root 1: c comment section
2: c
3: c fm005
4: c
5: c this routine tests the basic assumptions regarding the simple
6: c formatted write statement of form
7: c write (u,f) or
8: c write (u,f) l
9: c where u is a logical unit number
10: c f is a format statement label, and
11: c l is a list of integer variables.
12: c the format statement f contains nh hollerith field descriptors,
13: c nx blank field descriptors and iw numeric field descriptors.
14: c
15: c this routine tests whether the first character of a format
16: c record for printer output determines vertical spacing as follows
17: c blank - one line
18: c 1 - advance to first line of next page
19: c
20: c references
21: c american national standard programming language fortran,
22: c x3.9-1978
23: c
24: c section 12.8.2, input/output lists
25: c section 12.9.5.2, read, write, and print statement
26: c section 12.9.5.2.3, printing of formatted records
27: c section 13.5.2, h editing
28: c section 13.5.3.2, x editing
29: c section 13.5.9.1, numeric editing
30: c
31: c all of the results of this routine must be visually checked
32: c on the output report. the usual test code for pass, fail, or
33: c delete does not apply to this routine. if any test is to be
34: c deleted, change the offending write or format statement to a
35: c comment. the person responsible for checking the output must also
36: c check the compiler listing to see if any statements have been
37: c changed to comments.
38: c
39: c **********************************************************
40: c
41: c a compiler validation system for the fortran language
42: c based on specifications as defined in american national standard
43: c programming language fortran x3.9-1978, has been developed by the
44: c federal cobol compiler testing service. the fortran compiler
45: c validation system (fcvs) consists of audit routines, their related
46: c data, and an executive system. each audit routine is a fortran
47: c program, subprogram or function which includes tests of specific
48: c language elements and supporting procedures indicating the result
49: c of executing these tests.
50: c
51: c this particular program/subprogram/function contains features
52: c found only in the subset as defined in x3.9-1978.
53: c
54: c suggestions and comments should be forwarded to -
55: c
56: c department of the navy
57: c federal cobol compiler testing service
58: c washington, d.c. 20376
59: c
60: c **********************************************************
61: c
62: c
63: c
64: c initialization section
65: c
66: c initialize constants
67: c **************
68: c i01 contains the logical unit number for the card reader.
69: i01 = 5
70: c i02 contains the logical unit number for the printer.
71: i02 = 6
72: c system environment section
73: c
74: cx010 this card is replaced by contents of fexec x-010 control card.
75: c the cx010 card is for overriding the program default i01 = 5
76: c (unit number for card reader).
77: cx011 this card is replaced by contents of fexec x-011 control card.
78: c the cx011 card is for systems which require additional
79: c fortran statements for files associated with cx010 above.
80: c
81: cx020 this card is replaced by contents of fexec x-020 control card.
82: c the cx020 card is for overriding the program default i02 = 6
83: c (unit number for printer).
84: cx021 this card is replaced by contents of fexec x-021 control card.
85: c the cx021 card is for systems which require additional
86: c fortran statements for files associated with cx020 above.
87: c
88: ivpass=0
89: ivfail=0
90: ivdele=0
91: iczero=0
92: c
93: c write page headers
94: write (i02,90000)
95: write (i02,90001)
96: write (i02,90002)
97: write (i02, 90002)
98: write (i02,90003)
99: write (i02,90002)
100: write (i02,90004)
101: write (i02,90002)
102: write (i02,90011)
103: write (i02,90002)
104: write (i02,90002)
105: write (i02,90006)
106: write (i02,90002)
107: 331 continue
108: ivtnum = 33
109: c
110: c **** test 033 ****
111: c test 33 - vertical spacing test
112: c 1 in first character of formatted print record means
113: c record is first line at top of next page.
114: c
115: write (i02,80001) ivtnum
116: write (i02,80331)
117: 80331 format (5x,22hlast line on this page)
118: write (i02,80330)
119: 80330 format (1h1,31h this is first line on page)
120: 341 continue
121: ivtnum = 34
122: c
123: c **** test 034 ****
124: c test 34 - vertical spacing test
125: c print blank lines
126: c
127: write (i02,90002)
128: write (i02,80001) ivtnum
129: write (i02,80340)
130: 80340 format (1h , 10x)
131: write (i02,80341)
132: 80341 format (41h there is one blank line before this line)
133: write (i02,80342)
134: write (i02,80342)
135: 80342 format (11h )
136: write (i02,80343)
137: 80343 format (43h there are two blank lines before this line)
138: write (i02,80344)
139: write (i02,80344)
140: write (i02,80344)
141: 80344 format (11x)
142: write (i02,80345)
143: 80345 format (45h there are three blank lines before this line)
144: 351 continue
145: ivtnum = 35
146: c
147: c **** test 035 ****
148: c test 35 - print 54 characters
149: c
150: write (i02,90002)
151: write (i02,80001)ivtnum
152: write (i02,80351)
153: 80351 format (33h next line contains 54 characters)
154: write (i02,80350)
155: 80350 format(55h 123456789012345678901234567890123456789012345678901234)
156: 361 continue
157: ivtnum = 36
158: c
159: c **** test 036 ****
160: c test 36 - numeric field descriptor i1
161: c
162: write (i02,90000)
163: write (i02,90002)
164: write (i02,80001) ivtnum
165: write (i02,80361)
166: 80361 format (1h ,10x,38hthis test prints 3 under i1 descriptor)
167: ivon01 = 3
168: write (i02,80360) ivon01
169: 80360 format (1h ,10x,i1)
170: 371 continue
171: ivtnum = 37
172: c
173: c **** test 037 ****
174: c test 37 - numeric field descriptor i2
175: c
176: write (i02,90002)
177: write (i02,80001) ivtnum
178: write (i02,80371)
179: 80371 format (11x,39hthis test prints 15 under i2 descriptor)
180: ivon01 = 15
181: write (i02,80370) ivon01
182: 80370 format (1h ,10x,i2)
183: 381 continue
184: ivtnum = 38
185: c
186: c **** test 038 ****
187: c test 38 - numeric field descriptor i3
188: c
189: write (i02,90002)
190: write (i02,80001) ivtnum
191: write (i02,80381)
192: 80381 format (11x,40hthis test prints 291 under i3 descriptor)
193: ivon01 = 291
194: write (i02,80380) ivon01
195: 80380 format (11x,i3)
196: 391 continue
197: ivtnum = 39
198: c
199: c **** test 039 ****
200: c test 39 - numeric field descriptor i4
201: c
202: write (i02,90002)
203: write (i02,80001) ivtnum
204: write (i02,80391)
205: 80391 format (11x,41hthis test prints 4321 under i4 descriptor)
206: ivon01 = 4321
207: write (i02,80390) ivon01
208: 80390 format (11x,i4)
209: 401 continue
210: ivtnum = 40
211: c
212: c **** test 040 ****
213: c test 40 - numeric field descriptor i5
214: c
215: write (i02,90002)
216: write (i02,80001) ivtnum
217: write (i02,80401)
218: 80401 format (1h ,10x,42hthis test prints 12345 under i5 descriptor)
219: ivon01 = 12345
220: write (i02,80400) ivon01
221: 80400 format (1h ,10x,i5)
222: 411 continue
223: ivtnum = 41
224: c
225: c **** test 041 ****
226: c test 41 - numeric field descriptors, integer conversion
227: c
228: ivon01 = 1
229: ivon02 = 22
230: ivon03 = 333
231: ivon04 = 4444
232: ivon05 = 25555
233: write (i02,90002)
234: write (i02,80001) ivtnum
235: write (i02,80411)
236: 80411 format (3x,50hthis test prints 1, 22, 333, 4444, and 25555 under)
237: write (i02,80412)
238: 80412 format (10x,32h(10x,i1,3x,i2,3x,i3,3x,i4,3x,i5))
239: write (i02,80410) ivon01, ivon02, ivon03, ivon04, ivon05
240: 80410 format (10x,i1,3x,i2,3x,i3,3x,i4,3x,i5)
241: 421 continue
242: ivtnum = 42
243: c
244: c **** test 042 ****
245: c test 42 - hollerith, numeric and x field descriptors
246: c combine hollerith, numeric and x field descriptors in
247: c one format statement
248: c
249: ivon01=113
250: ivon02=8
251: write (i02,90002)
252: write (i02,80001) ivtnum
253: write (i02,80421)
254: 80421 format (10x,28hnext two lines are identical)
255: write (i02,80422)
256: 80422 format (35h ivon01 = 113 ivon02 = 8)
257: write (i02,80420) ivon01, ivon02
258: 80420 format (6x,8hivon01 =,i5,3x,8hivon02 =,i5)
259: 431 continue
260: ivtnum=43
261: c
262: c **** test 043 ****
263: c test 43 - numeric field descriptor i2
264: c print negative integer
265: c
266: ivon01 = -1
267: write (i02,90000)
268: write (i02,90002)
269: write (i02,80001) ivtnum
270: write (i02,80431)
271: 80431 format (11x,39hthis test prints -1 under i2 descriptor)
272: write (i02,80430) ivon01
273: 80430 format (11x,i2)
274: 441 continue
275: ivtnum = 44
276: c
277: c **** test 044 ****
278: c test 44 - numeric field descriptor i3
279: c print negative integer
280: c
281: ivon01 = -22
282: write (i02,90002)
283: write (i02,80001) ivtnum
284: write (i02,80441)
285: 80441 format (11x,40hthis test prints -22 under i3 descriptor)
286: write (i02,80440) ivon01
287: 80440 format (11x,i3)
288: 451 continue
289: ivtnum = 45
290: c
291: c **** test 045 ****
292: c test 45 - numeric field descriptor i4
293: c print negative integer
294: c
295: ivon01 = -333
296: write (i02,90002)
297: write (i02,80001) ivtnum
298: write (i02,80451)
299: 80451 format (11x,41hthis test prints -333 under i4 descriptor)
300: write (i02,80450) ivon01
301: 80450 format (11x,i4)
302: 461 continue
303: ivtnum = 46
304: c
305: c **** test 046 ****
306: c test 46 - numeric field descriptor i5
307: c print negative integer
308: c
309: ivon01 = -4444
310: write (i02,90002)
311: write (i02,80001) ivtnum
312: write (i02,80461)
313: 80461 format (11x,42hthis test prints -4444 under i5 descriptor)
314: write (i02,80460) ivon01
315: 80460 format (11x,i5)
316: 471 continue
317: ivtnum = 47
318: c
319: c **** test 047 ****
320: c test 47 - numeric field descriptor i6
321: c print negative integer
322: c
323: ivon01 = -15555
324: write (i02,90002)
325: write (i02,80001) ivtnum
326: write (i02,80471)
327: 80471 format (11x,43hthis test prints -15555 under descriptor i6)
328: write (i02,80470) ivon01
329: 80470 format (11x,i6)
330: 481 continue
331: ivtnum = 48
332: c
333: c **** test 048 ****
334: c test 48 - numeric field descriptors, integer conversion
335: c print negative integers
336: c
337: ivon01 = -9
338: ivon02 = -88
339: ivon03 = -777
340: ivon04 = -6666
341: ivon05 = -25555
342: write (i02,90002)
343: write (i02,80001) ivtnum
344: write (i02,80481)
345: 80481 format (8x,49hthis test prints -9, -88, -777, -6666, and -25555)
346: write (i02,80482)
347: 80482 format (11x,43hunder format 10x,i2,3x,i3,3x,i4,3x,i5,3x,i6)
348: write (i02,80480) ivon01,ivon02,ivon03,ivon04,ivon05
349: 80480 format (10x,i2,3x,i3,3x,i4,3x,i5,3x,i6)
350: 491 continue
351: ivtnum = 49
352: c
353: c **** test 049 ****
354: c test 49 - numeric field descriptor i5
355: c mix positive and negative integer output in one format
356: c statement all under i5 descriptor
357: c
358: ivon01 =5
359: ivon02 = -54
360: ivon03 = 543
361: ivon04 = -5432
362: ivon05=32000
363: write (i02,90002)
364: write (i02,80001) ivtnum
365: write (i02,80491)
366: 80491 format (18x,46hthis test prints 5, -54, 543, -5432, and 32000)
367: write (i02,80492)
368: 80492 format (11x,33hunder i5 numeric field descriptor)
369: write (i02,80490) ivon01,ivon02,ivon03,ivon04,ivon05
370: 80490 format (11x,i5,3x,i5,3x,i5,3x,i5,3x,i5)
371: c
372: c write page footings
373: 99999 continue
374: write (i02,90002)
375: write (i02,90006)
376: write (i02,90002)
377: write (i02,90007)
378: c
379: c terminate routine execution
380: stop
381: c
382: c format statements for page headers
383: 90000 format (1h1)
384: 90002 format (1h )
385: 90001 format (1h ,10x,34hfortran compiler validation system)
386: 90003 format (1h ,21x,11hversion 1.0)
387: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
388: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
389: 90006 format (1h ,5x,46h----------------------------------------------)
390: 90011 format (1h ,18x,17hsubset level test)
391: c format statements for this routine
392: 80001 format (10x,5htest ,i2)
393: 90007 format (1h ,20x,20hend of program fm005)
394: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.