![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm013.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 fm013.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 fm013
5: c
6: c this routine tests the fortran assigned go to statement
7: c as described in section 11.3 (assigned go to statement). first a
8: c statement label is assigned to an integer variable in the assign
9: c statement. secondly a branch is made in an assigned go to
10: c statement using the integer variable as the branch controller
11: c in a list of possible statement numbers to be branched to.
12: c
13: c references
14: c american national standard programming language fortran,
15: c x3.9-1978
16: c
17: c section 10.3, statement label assignment (assign) statement
18: c section 11.3, assigned go to statement
19: c
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 = 126
91: c
92: c test 126 - this tests the simple assign statement in preparation
93: c for the assigned go to test to follow.
94: c the assigned go to is the simplist form of the statement.
95: c
96: c
97: if (iczero) 31260, 1260, 31260
98: 1260 continue
99: assign 1263 to i
100: go to i, (1262,1263,1264)
101: 1262 icon01 = 1262
102: go to 1265
103: 1263 icon01 = 1263
104: go to 1265
105: 1264 icon01 = 1264
106: 1265 continue
107: go to 41260
108: 31260 ivdele = ivdele + 1
109: write (i02,80003) ivtnum
110: if (iczero) 41260, 1271, 41260
111: 41260 if ( icon01 - 1263 ) 21260, 11260, 21260
112: 11260 ivpass = ivpass + 1
113: write (i02,80001) ivtnum
114: go to 1271
115: 21260 ivfail = ivfail + 1
116: ivcomp=icon01
117: ivcorr = 1263
118: write (i02,80004) ivtnum, ivcomp ,ivcorr
119: 1271 continue
120: ivtnum = 127
121: c
122: c test 127 - this is a test of more complex branching using
123: c the assign and assigned go to statements. this test is not
124: c intended to be an example of structured programming.
125: c
126: c
127: if (iczero) 31270, 1270, 31270
128: 1270 continue
129: ivon01=0
130: 1272 assign 1273 to j
131: ivon01=ivon01+1
132: go to 1276
133: 1273 assign 1274 to j
134: ivon01=ivon01 * 10 + 2
135: go to 1276
136: 1274 assign 1275 to j
137: ivon01=ivon01 * 100 + 3
138: go to 1276
139: 1275 go to 1277
140: 1276 go to j, ( 1272, 1273, 1274, 1275 )
141: 1277 continue
142: go to 41270
143: 31270 ivdele = ivdele + 1
144: write (i02,80003) ivtnum
145: if (iczero) 41270, 1281, 41270
146: 41270 if ( ivon01 - 1203 ) 21270, 11270, 21270
147: 11270 ivpass = ivpass + 1
148: write (i02,80001) ivtnum
149: go to 1281
150: 21270 ivfail = ivfail + 1
151: ivcomp=ivon01
152: ivcorr=1203
153: write (i02,80004) ivtnum, ivcomp ,ivcorr
154: 1281 continue
155: ivtnum = 128
156: c
157: c test 128 - test of the assigned go to with all of the
158: c statement numbers in the assigned go to list the same
159: c value except for one.
160: c
161: c
162: if (iczero) 31280, 1280, 31280
163: 1280 continue
164: icon01=0
165: assign 1283 to k
166: go to k, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 )
167: 1282 icon01 = 0
168: go to 1284
169: 1283 icon01 = 1
170: 1284 continue
171: go to 41280
172: 31280 ivdele = ivdele + 1
173: write (i02,80003) ivtnum
174: if (iczero) 41280, 1291, 41280
175: 41280 if ( icon01 - 1 ) 21280, 11280, 21280
176: 11280 ivpass = ivpass + 1
177: write (i02,80001) ivtnum
178: go to 1291
179: 21280 ivfail = ivfail + 1
180: ivcomp=icon01
181: ivcorr=1
182: write (i02,80004) ivtnum, ivcomp ,ivcorr
183: 1291 continue
184: ivtnum = 129
185: c
186: c test 129 - this tests the assign statement in conjunction
187: c with the normal arithmetic assign statement. the value
188: c of the index for the assigned go to statement is changed by
189: c the combination of statements.
190: c
191: c
192: if (iczero) 31290, 1290, 31290
193: 1290 continue
194: icon01=0
195: assign 1292 to l
196: l = 1293
197: assign 1294 to l
198: go to l, ( 1294, 1293, 1292 )
199: 1292 icon01 = 0
200: go to 1295
201: 1293 icon01 = 0
202: go to 1295
203: 1294 icon01 = 1
204: 1295 continue
205: go to 41290
206: 31290 ivdele = ivdele + 1
207: write (i02,80003) ivtnum
208: if (iczero) 41290, 1301, 41290
209: 41290 if ( icon01 - 1 ) 21290, 11290, 21290
210: 11290 ivpass = ivpass + 1
211: write (i02,80001) ivtnum
212: go to 1301
213: 21290 ivfail = ivfail + 1
214: ivcomp=icon01
215: ivcorr=1
216: write (i02,80004) ivtnum, ivcomp ,ivcorr
217: 1301 continue
218: ivtnum = 130
219: c
220: c test 130 - this is a test of a loop using a combination of the
221: c assigned go to statement and the arithmetic if statement.
222: c the loop should be executed eleven (11) times then control
223: c should pass to the check of the value for ivon01.
224: c
225: c
226: if (iczero) 31300, 1300, 31300
227: 1300 continue
228: ivon01=0
229: 1302 assign 1302 to m
230: ivon01=ivon01+1
231: if ( ivon01 - 10 ) 1303, 1303, 1304
232: 1303 go to 1305
233: 1304 assign 1306 to m
234: 1305 go to m, ( 1302, 1306 )
235: 1306 continue
236: go to 41300
237: 31300 ivdele = ivdele + 1
238: write (i02,80003) ivtnum
239: if (iczero) 41300, 1311, 41300
240: 41300 if ( ivon01 - 11 ) 21300, 11300, 21300
241: 11300 ivpass = ivpass + 1
242: write (i02,80001) ivtnum
243: go to 1311
244: 21300 ivfail = ivfail + 1
245: ivcomp=ivon01
246: ivcorr=11
247: write (i02,80004) ivtnum, ivcomp ,ivcorr
248: 1311 continue
249: c
250: c write page footings and run summaries
251: 99999 continue
252: write (i02,90002)
253: write (i02,90006)
254: write (i02,90002)
255: write (i02,90002)
256: write (i02,90007)
257: write (i02,90002)
258: write (i02,90008) ivfail
259: write (i02,90009) ivpass
260: write (i02,90010) ivdele
261: c
262: c
263: c terminate routine execution
264: stop
265: c
266: c format statements for page headers
267: 90000 format (1h1)
268: 90002 format (1h )
269: 90001 format (1h ,10x,34hfortran compiler validation system)
270: 90003 format (1h ,21x,11hversion 1.0)
271: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
272: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
273: 90006 format (1h ,5x,46h----------------------------------------------)
274: 90011 format (1h ,18x,17hsubset level test)
275: c
276: c format statements for run summaries
277: 90008 format (1h ,15x,i5,19h errors encountered)
278: 90009 format (1h ,15x,i5,13h tests passed)
279: 90010 format (1h ,15x,i5,14h tests deleted)
280: c
281: c format statements for test results
282: 80001 format (1h ,4x,i5,7x,4hpass)
283: 80002 format (1h ,4x,i5,7x,4hfail)
284: 80003 format (1h ,4x,i5,7x,7hdeleted)
285: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
286: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
287: c
288: 90007 format (1h ,20x,20hend of program fm013)
289: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.