![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm011.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 fm011.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 root 1: c comment section.
2: c
3: c fm011
4: c
5: c this routine is a test of blank characters (section 3.1.6)
6: c which should have no meaning when embedded in fortran reserved
7: c words.
8: c references
9: c american national standard programming language fortran,
10: c x3.9-1978
11: c
12: c section 3.1.6, blank character
13: dim en sion iadn11(3),iadn12(3)
14: in teger rvtni1
15: rea l ivtnr1
16: log ical lvtnl1,lvtnl2
17: com mon iace11(3)
18: equ ival ence (iace11(1),iadn11(1))
19: d a t a iadn12/3*3/
20: c
21: c **********************************************************
22: c
23: c a compiler validation system for the fortran language
24: c based on specifications as defined in american national standard
25: c programming language fortran x3.9-1978, has been developed by the
26: c federal cobol compiler testing service. the fortran compiler
27: c validation system (fcvs) consists of audit routines, their related
28: c data, and an executive system. each audit routine is a fortran
29: c program, subprogram or function which includes tests of specific
30: c language elements and supporting procedures indicating the result
31: c of executing these tests.
32: c
33: c this particular program/subprogram/function contains features
34: c found only in the subset as defined in x3.9-1978.
35: c
36: c suggestions and comments should be forwarded to -
37: c
38: c department of the navy
39: c federal cobol compiler testing service
40: c washington, d.c. 20376
41: c
42: c **********************************************************
43: c
44: c
45: c
46: c initialization section
47: c
48: c initialize constants
49: c **************
50: c i01 contains the logical unit number for the card reader.
51: i01 = 5
52: c i02 contains the logical unit number for the printer.
53: i02 = 6
54: c system environment section
55: c
56: cx010 this card is replaced by contents of fexec x-010 control card.
57: c the cx010 card is for overriding the program default i01 = 5
58: c (unit number for card reader).
59: cx011 this card is replaced by contents of fexec x-011 control card.
60: c the cx011 card is for systems which require additional
61: c fortran statements for files associated with cx010 above.
62: c
63: cx020 this card is replaced by contents of fexec x-020 control card.
64: c the cx020 card is for overriding the program default i02 = 6
65: c (unit number for printer).
66: cx021 this card is replaced by contents of fexec x-021 control card.
67: c the cx021 card is for systems which require additional
68: c fortran statements for files associated with cx020 above.
69: c
70: ivpass=0
71: ivfail=0
72: ivdele=0
73: iczero=0
74: c
75: c write page headers
76: write (i02,90000)
77: write (i02,90001)
78: write (i02,90002)
79: write (i02, 90002)
80: write (i02,90003)
81: write (i02,90002)
82: write (i02,90004)
83: write (i02,90002)
84: write (i02,90011)
85: write (i02,90002)
86: write (i02,90002)
87: write (i02,90005)
88: write (i02,90006)
89: write (i02,90002)
90: ivtnum = 103
91: c
92: c **** test 103 ****
93: c test 103 - this test has blanks embedded in a dimension
94: c statement. also the do statement with an embedded blank
95: c will be tested to initialize values in an array. the
96: c continue and if statements have embedded blanks as well.
97: c
98: if (iczero) 31030, 1030, 31030
99: 1030 continue
100: d o 1 ivon01 =1 , 3 , 1
101: iadn11(ivon01) = ivon01
102: 1 c on t in ue
103: go to 41030
104: 31030 ivdele = ivdele + 1
105: write (i02,80003) ivtnum
106: if (iczero) 41030, 1041, 41030
107: 41030 i f (iadn11(2) - 2) 21030,11030,21030
108: 11030 ivpass = ivpass + 1
109: write (i02,80001) ivtnum
110: go to 1041
111: 21030 ivfail = ivfail + 1
112: ivcomp = iadn11(2)
113: ivcorr = 2
114: write (i02,80004) ivtnum, ivcomp ,ivcorr
115: 1041 continue
116: ivtnum = 104
117: c
118: c **** test 104 ****
119: c test 104 - this tests embedded blanks in an integer type
120: c statement. fraction 1/2 should become 0 as an integer.
121: c integer to real * 2. back to integer conversion should be 0.
122: c
123: if (iczero) 31040, 1040, 31040
124: 1040 continue
125: rvtni1 = 2
126: rvon01 = 1/rvtni1
127: ivon02 = rvon01 * 2.
128: go to 41040
129: 31040 ivdele = ivdele + 1
130: write (i02,80003) ivtnum
131: if (iczero) 41040, 1051, 41040
132: 41040 if( ivon02 - 0 ) 21040,11040,21040
133: 11040 ivpass = ivpass + 1
134: write (i02,80001) ivtnum
135: go to 1051
136: 21040 ivfail = ivfail + 1
137: ivcomp = ivon02
138: ivcorr = 0
139: write (i02,80004) ivtnum, ivcomp ,ivcorr
140: 1051 continue
141: ivtnum = 105
142: c
143: c **** test 105 ****
144: c test 105 - test of embedded blanks in a real type statement.
145: c real to real*2. to integer conversion is performed. result
146: c is 1 if the type of the test variable(ivtnr1) was real.
147: c
148: if (iczero) 31050, 1050, 31050
149: 1050 continue
150: ivtnr1 = .5
151: rvon03 = ivtnr1*2.
152: ivon03 = rvon03 +.3
153: go to 41050
154: 31050 ivdele = ivdele + 1
155: write (i02,80003) ivtnum
156: if (iczero) 41050, 1061, 41050
157: 41050 if(ivon03 - 1) 21050, 11050, 21050
158: 11050 ivpass = ivpass + 1
159: write (i02,80001) ivtnum
160: go to 1061
161: 21050 ivfail = ivfail + 1
162: ivcomp = ivon03
163: ivcorr = 1
164: write (i02,80004) ivtnum, ivcomp ,ivcorr
165: 1061 continue
166: ivtnum = 106
167: c
168: c **** test 106 ****
169: c test 106 - test the logical type with embedded blanks by a
170: c logic assignment (v = .true.) section 4.7.1 and 10.2
171: c
172: if (iczero) 31060, 1060, 31060
173: 1060 continue
174: lvtnl1 = .true.
175: go to 41060
176: 31060 ivdele = ivdele + 1
177: write (i02,80003) ivtnum
178: if (iczero) 41060, 1071, 41060
179: 41060 if(iczero) 21060,11060,21060
180: 11060 ivpass = ivpass + 1
181: write (i02,80001) ivtnum
182: go to 1071
183: 21060 ivfail = ivfail + 1
184: write (i02,80002) ivtnum, ivcomp ,ivcorr
185: 1071 continue
186: ivtnum = 107
187: c
188: c **** test 107 ****
189: c test 107 - a second test of the logical type statement with
190: c embedded blanks. the test is again made by a logical
191: c assignment (section 4.7.1 and 10.2).
192: c
193: if (iczero) 31070, 1070, 31070
194: 1070 continue
195: lvtnl2 = .false.
196: go to 41070
197: 31070 ivdele = ivdele + 1
198: write (i02,80003) ivtnum
199: if (iczero) 41070, 1081, 41070
200: 41070 if(iczero) 21070,11070,21070
201: 11070 ivpass = ivpass + 1
202: write (i02,80001) ivtnum
203: go to 1081
204: 21070 ivfail = ivfail + 1
205: write (i02,80002) ivtnum, ivcomp ,ivcorr
206: 1081 continue
207: ivtnum = 108
208: c
209: c **** test 108 ****
210: c test 108 - this is a test of blanks embedded in the common,
211: c dimension and equivalence statements (section 8.1,
212: c 8.3. and 8.2.).
213: c
214: if (iczero) 31080, 1080, 31080
215: 1080 continue
216: iadn11(3) = 4
217: go to 41080
218: 31080 ivdele = ivdele + 1
219: write (i02,80003) ivtnum
220: if (iczero) 41080, 1091, 41080
221: 41080 if(iace11(3) - 4) 21080,11080,21080
222: 11080 ivpass = ivpass + 1
223: write (i02,80001) ivtnum
224: go to 1091
225: 21080 ivfail = ivfail + 1
226: ivcomp = iace11(3)
227: ivcorr = 4
228: write (i02,80004) ivtnum, ivcomp ,ivcorr
229: 1091 continue
230: ivtnum = 109
231: c
232: c **** test 109 ****
233: c test 109 - this tests the effect of blanks embedded in the
234: c data statement by checking the initialization of array
235: c element values (section 9).
236: c
237: if (iczero) 31090, 1090, 31090
238: 1090 continue
239: ivon04 = iadn12(1) + iadn12(2) + iadn12(3)
240: go to 41090
241: 31090 ivdele = ivdele + 1
242: write (i02,80003) ivtnum
243: if (iczero) 41090, 1101, 41090
244: 41090 if(ivon04 - 9) 21090,11090,21090
245: 11090 ivpass = ivpass + 1
246: write (i02,80001) ivtnum
247: go to 1101
248: 21090 ivfail = ivfail + 1
249: ivcomp = ivon04
250: ivcorr = 9
251: write (i02,80004) ivtnum, ivcomp ,ivcorr
252: 1101 continue
253: c
254: c write page footings and run summaries
255: 99999 continue
256: write (i02,90002)
257: write (i02,90006)
258: write (i02,90002)
259: write (i02,90002)
260: write (i02,90007)
261: write (i02,90002)
262: write (i02,90008) ivfail
263: write (i02,90009) ivpass
264: write (i02,90010) ivdele
265: c
266: c
267: c terminate routine execution
268: stop
269: c
270: c format statements for page headers
271: 90000 format (1h1)
272: 90002 format (1h )
273: 90001 format (1h ,10x,34hfortran compiler validation system)
274: 90003 format (1h ,21x,11hversion 1.0)
275: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
276: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
277: 90006 format (1h ,5x,46h----------------------------------------------)
278: 90011 format (1h ,18x,17hsubset level test)
279: c
280: c format statements for run summaries
281: 90008 format (1h ,15x,i5,19h errors encountered)
282: 90009 format (1h ,15x,i5,13h tests passed)
283: 90010 format (1h ,15x,i5,14h tests deleted)
284: c
285: c format statements for test results
286: 80001 format (1h ,4x,i5,7x,4hpass)
287: 80002 format (1h ,4x,i5,7x,4hfail)
288: 80003 format (1h ,4x,i5,7x,7hdeleted)
289: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
290: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
291: c
292: 90007 format (1h ,20x,20hend of program fm011)
293: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.