xref: /original-bsd/usr.bin/f77/tests/tests/fm013.f (revision 9fa17c5f)
1c
2c     comment section.
3c
4c     fm013
5c
6c             this routine tests the fortran  assigned go to statement
7c     as described in section 11.3 (assigned go to statement). first a
8c     statement label is assigned to an integer variable in the assign
9c     statement.  secondly a branch is made in an assigned go to
10c     statement using the integer variable as the branch controller
11c     in a list of possible statement numbers to be branched to.
12c
13c      references
14c        american national standard programming language fortran,
15c              x3.9-1978
16c
17c        section 10.3, statement label assignment (assign) statement
18c        section 11.3, assigned go to statement
19c
20c
21c      **********************************************************
22c
23c         a compiler validation system for the fortran language
24c     based on specifications as defined in american national standard
25c     programming language fortran x3.9-1978, has been developed by the
26c     federal cobol compiler testing service.  the fortran compiler
27c     validation system (fcvs) consists of audit routines, their related
28c     data, and an executive system.  each audit routine is a fortran
29c     program, subprogram or function which includes tests of specific
30c     language elements and supporting procedures indicating the result
31c     of executing these tests.
32c
33c         this particular program/subprogram/function contains features
34c     found only in the subset as defined in x3.9-1978.
35c
36c         suggestions and comments should be forwarded to -
37c
38c                  department of the navy
39c                  federal cobol compiler testing service
40c                  washington, d.c.  20376
41c
42c      **********************************************************
43c
44c
45c
46c     initialization section
47c
48c     initialize constants
49c      **************
50c     i01 contains the logical unit number for the card reader.
51      i01 = 5
52c     i02 contains the logical unit number for the printer.
53      i02 = 6
54c     system environment section
55c
56cx010    this card is replaced by contents of fexec x-010 control card.
57c     the cx010 card is for overriding the program default i01 = 5
58c     (unit number for card reader).
59cx011    this card is replaced by contents of fexec x-011 control card.
60c     the cx011 card is for systems which require additional
61c     fortran statements for files associated with cx010 above.
62c
63cx020    this card is replaced by contents of fexec x-020 control card.
64c     the cx020 card is for overriding the program default i02 = 6
65c     (unit number for printer).
66cx021    this card is replaced by contents of fexec x-021 control card.
67c     the cx021 card is for systems which require additional
68c     fortran statements for files associated with cx020 above.
69c
70      ivpass=0
71      ivfail=0
72      ivdele=0
73      iczero=0
74c
75c     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
91c
92c     test 126  -  this tests the simple assign statement in preparation
93c           for the assigned go to test to follow.
94c           the assigned go to is the simplist form of the statement.
95c
96c
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
10831260 ivdele = ivdele + 1
109      write (i02,80003) ivtnum
110      if (iczero) 41260, 1271, 41260
11141260 if ( icon01 - 1263 )  21260, 11260, 21260
11211260 ivpass = ivpass + 1
113      write (i02,80001) ivtnum
114      go to 1271
11521260 ivfail = ivfail + 1
116      ivcomp=icon01
117      ivcorr = 1263
118      write (i02,80004) ivtnum, ivcomp ,ivcorr
119 1271 continue
120      ivtnum = 127
121c
122c     test 127  -  this is a test of more complex branching using
123c           the assign and assigned go to statements.  this test is not
124c           intended to be an example of structured programming.
125c
126c
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
14331270 ivdele = ivdele + 1
144      write (i02,80003) ivtnum
145      if (iczero) 41270, 1281, 41270
14641270 if ( ivon01 - 1203 )  21270, 11270, 21270
14711270 ivpass = ivpass + 1
148      write (i02,80001) ivtnum
149      go to 1281
15021270 ivfail = ivfail + 1
151      ivcomp=ivon01
152      ivcorr=1203
153      write (i02,80004) ivtnum, ivcomp ,ivcorr
154 1281 continue
155      ivtnum = 128
156c
157c     test 128  -  test of the assigned go to with all of the
158c           statement numbers in the assigned go to list the same
159c           value except for one.
160c
161c
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
17231280 ivdele = ivdele + 1
173      write (i02,80003) ivtnum
174      if (iczero) 41280, 1291, 41280
17541280 if ( icon01 - 1 )  21280, 11280, 21280
17611280 ivpass = ivpass + 1
177      write (i02,80001) ivtnum
178      go to 1291
17921280 ivfail = ivfail + 1
180      ivcomp=icon01
181      ivcorr=1
182      write (i02,80004) ivtnum, ivcomp ,ivcorr
183 1291 continue
184      ivtnum = 129
185c
186c     test 129  -  this tests the assign statement in conjunction
187c           with the normal arithmetic assign statement.  the value
188c           of the index for the assigned go to statement is changed by
189c           the combination of statements.
190c
191c
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
20631290 ivdele = ivdele + 1
207      write (i02,80003) ivtnum
208      if (iczero) 41290, 1301, 41290
20941290 if ( icon01 - 1 )  21290, 11290, 21290
21011290 ivpass = ivpass + 1
211      write (i02,80001) ivtnum
212      go to 1301
21321290 ivfail = ivfail + 1
214      ivcomp=icon01
215      ivcorr=1
216      write (i02,80004) ivtnum, ivcomp ,ivcorr
217 1301 continue
218      ivtnum = 130
219c
220c     test 130  -  this is a test of a loop using a combination of the
221c           assigned go to statement and the arithmetic if statement.
222c           the loop should be executed eleven (11) times then control
223c           should pass to the check of the value for ivon01.
224c
225c
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
23731300 ivdele = ivdele + 1
238      write (i02,80003) ivtnum
239      if (iczero) 41300, 1311, 41300
24041300 if ( ivon01 - 11 )  21300, 11300, 21300
24111300 ivpass = ivpass + 1
242      write (i02,80001) ivtnum
243      go to 1311
24421300 ivfail = ivfail + 1
245      ivcomp=ivon01
246      ivcorr=11
247      write (i02,80004) ivtnum, ivcomp ,ivcorr
248 1311 continue
249c
250c     write page footings and run summaries
25199999 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
261c
262c
263c     terminate routine execution
264      stop
265c
266c     format statements for page headers
26790000 format (1h1)
26890002 format (1h )
26990001 format (1h ,10x,34hfortran compiler validation system)
27090003 format (1h ,21x,11hversion 1.0)
27190004 format (1h ,10x,38hfor official use only - copyright 1978)
27290005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
27390006 format (1h ,5x,46h----------------------------------------------)
27490011 format (1h ,18x,17hsubset level test)
275c
276c     format statements for run summaries
27790008 format (1h ,15x,i5,19h errors encountered)
27890009 format (1h ,15x,i5,13h tests passed)
27990010 format (1h ,15x,i5,14h tests deleted)
280c
281c     format statements for test results
28280001 format (1h ,4x,i5,7x,4hpass)
28380002 format (1h ,4x,i5,7x,4hfail)
28480003 format (1h ,4x,i5,7x,7hdeleted)
28580004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
28680005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
287c
28890007 format (1h ,20x,20hend of program fm013)
289      end
290