![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM104.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM104.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 root 1: C COMMENT SECTION. 00010104
2: C DATE***82/08/02*18.33.46
3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
4: C AUDIT FCVS78 V2.0
5: C 00020104
6: C FM104 00030104
7: C 00040104
8: C THIS ROUTINE IS A TEST OF THE / FORMAT AND IS TAPE AND PRINTER00050104
9: C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060104
10: C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070104
11: C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080104
12: C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090104
13: C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100104
14: C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110104
15: C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120104
16: C INTEGER ARRAY FOR THE DUMP SECTION. 00130104
17: C 00140104
18: C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150104
19: C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00160104
20: C CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS 00170104
21: C AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED. 00180104
22: C 00190104
23: C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00200104
24: C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00210104
25: C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00220104
26: C OF THE CONTINUATION LINE. 00230104
27: C 00240104
28: C REFERENCES 00250104
29: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260104
30: C X3.9-1978 00270104
31: C 00280104
32: C SECTION 8, SPECIFICATION STATEMENTS 00290104
33: C SECTION 9, DATA STATEMENT 00300104
34: C SECTION 11.10, DO STATEMENT 00310104
35: C SECTION 12, INPUT/OUTPUT STATEMENTS 00320104
36: C SECTION 12.8.2, INPUT/OUTPUT LIST 00330104
37: C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00340104
38: C SECTION 13, FORMAT STATEMENT 00350104
39: C SECTION 13.2.1, EDIT DESCRIPTORS 00360104
40: C SECTION 13.5.9.1, INTEGER EDITING 00370104
41: C 00380104
42: COMMON ITEST(7), IACN11(57), ICHEC 00390104
43: C 00400104
44: DIMENSION IPREM(7), IADN11(57) 00410104
45: DIMENSION IDUMP(136) 00420104
46: CHARACTER*1 NINE,IZERO,IDUMP 00430104
47: DATA NINE/'9'/, IZERO/'0'/ 00440104
48: C 00450104
49: 77701 FORMAT ( 80A1 ) 00460104
50: 77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O00470104
51: 1F ,I3,8H RECORDS) 00480104
52: 77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS) 00490104
53: 77704 FORMAT (10X,12HFILE ON LUN ,I2,20H NO EOF.. MORE THAN ,I3,8H RECOR00500104
54: 1DS) 00510104
55: 77705 FORMAT ( 1X,80A1) 00520104
56: 77706 FORMAT (10X,43HFILE I06 CREATED WITH 28 SEQUENTIAL RECORDS) 00530104
57: 77751 FORMAT (I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,00540104
58: 157I1,I3/I3,2I2,3I3,I4,57I1,I3 ) 00550104
59: 77752 FORMAT (7X,I3,6X,I4,I1,56X,I3/7X,I3,67X,I3/7X,I3,67X,I3/7X,I3,67X,00560104
60: 1I3 ) 00570104
61: C 00580104
62: C 00590104
63: C ********************************************************** 00600104
64: C 00610104
65: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00620104
66: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00630104
67: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00640104
68: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00650104
69: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00660104
70: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00670104
71: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00680104
72: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00690104
73: C OF EXECUTING THESE TESTS. 00700104
74: C 00710104
75: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00720104
76: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00730104
77: C 00740104
78: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00750104
79: C 00760104
80: C DEPARTMENT OF THE NAVY 00770104
81: C FEDERAL COBOL COMPILER TESTING SERVICE 00780104
82: C WASHINGTON, D.C. 20376 00790104
83: C 00800104
84: C ********************************************************** 00810104
85: C 00820104
86: C 00830104
87: C 00840104
88: C INITIALIZATION SECTION 00850104
89: C 00860104
90: C INITIALIZE CONSTANTS 00870104
91: C ************** 00880104
92: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00890104
93: I01 = 5 00900104
94: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00910104
95: I02 = 6 00920104
96: C SYSTEM ENVIRONMENT SECTION 00930104
97: C 00940104
98: I01 = 5 00950104
99: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00960104
100: C (UNIT NUMBER FOR CARD READER). 00970104
101: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00980104
102: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00990104
103: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01000104
104: C 01010104
105: I02 = 6 01020104
106: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01030104
107: C (UNIT NUMBER FOR PRINTER). 01040104
108: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01050104
109: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01060104
110: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01070104
111: C 01080104
112: IVPASS=0 01090104
113: IVFAIL=0 01100104
114: IVDELE=0 01110104
115: ICZERO=0 01120104
116: C 01130104
117: C WRITE PAGE HEADERS 01140104
118: WRITE (I02,90000) 01150104
119: WRITE (I02,90001) 01160104
120: WRITE (I02,90002) 01170104
121: WRITE (I02, 90002) 01180104
122: WRITE (I02,90003) 01190104
123: WRITE (I02,90002) 01200104
124: WRITE (I02,90004) 01210104
125: WRITE (I02,90002) 01220104
126: WRITE (I02,90011) 01230104
127: WRITE (I02,90002) 01240104
128: WRITE (I02,90002) 01250104
129: WRITE (I02,90005) 01260104
130: WRITE (I02,90006) 01270104
131: WRITE (I02,90002) 01280104
132: C 01290104
133: C DEFAULT ASSIGNMENT FOR FILE 05 IS I06 = 7 01300104
134: I06 = 7 01310104
135: OPEN(UNIT=I06,ACCESS='SEQUENTIAL',FORM='FORMATTED') 01320104
136: CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061 01330104
137: C 01340104
138: C WRITE SECTION.... 01350104
139: C 01360104
140: C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS 01370104
141: C 80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY 01380104
142: C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01390104
143: C ROUTINE FM104 AND FOR PURPOSES OF IDENTIFICATION IS FILE 05. 01400104
144: C SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4) 01410104
145: C RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT. ALL FOUR 01420104
146: C OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20 01430104
147: C CHARACTER PREAMBLE. THE INTEGER STORED IN CHARACTER POSITIONS 01440104
148: C 78 - 80 WILL EQUAL THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR 01450104
149: C THE FOUR RECORD SET RESPECTIVELY.. THE INTEGER ARRAY ELEMENTS 01460104
150: C IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9. 01470104
151: IPROG = 104 01480104
152: IFILE = 05 01490104
153: ILUN = I06 01500104
154: ITOTR = 28 01510104
155: IRLGN = 80 01520104
156: IEOF = 0000 01530104
157: C SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF.. 01540104
158: IPREM(1) = IPROG 01550104
159: IPREM(2) = IFILE 01560104
160: IPREM(3) = ILUN 01570104
161: IPREM(5) = ITOTR 01580104
162: IPREM(6) = IRLGN 01590104
163: C SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9 01600104
164: DO 10 I = 1, 57 01610104
165: IADN11(I) = 9 01620104
166: 10 CONTINUE 01630104
167: DO 872 IRNUM = 1, 7 01640104
168: IF ( IRNUM .EQ. 7 ) IEOF = 9999 01650104
169: IPREM(4) = IRNUM 01660104
170: IPREM(7) = IEOF 01670104
171: IVON02 = IRNUM 01680104
172: IVON03 = IRNUM + 1 01690104
173: IVON04 = IRNUM + 2 01700104
174: IVON05 = IRNUM + 3 01710104
175: WRITE ( I06, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101720104
176: 11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON01730104
177: 205 01740104
178: 872 CONTINUE 01750104
179: WRITE (I02,77706) 01760104
180: C 01770104
181: C REWIND SECTION 01780104
182: C 01790104
183: REWIND I06 01800104
184: C 01810104
185: C READ SECTION.... 01820104
186: C 01830104
187: IVTNUM = 87 01840104
188: C 01850104
189: C **** TEST 87 THRU TEST 93 **** 01860104
190: C TEST 87 THRU 93 - THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS 01870104
191: C CREATED AS FILE I06 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS, 01880104
192: C AND THE END OF FILE INDICATOR. 01890104
193: C 01900104
194: DO 932 IRNUM = 1, 7 01910104
195: IVON01 = 0 01920104
196: C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 87 - 93.01930104
197: READ ( I06, 77752 ) IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,01940104
198: 1IVON09,IRN04,IVON10 01950104
199: C READ THE FILE I06 - NOTE, FOUR RECORDS ARE READ IN EACH SINGLE 01960104
200: C READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO 01970104
201: C CREATE THE FILE. 01980104
202: C 01990104
203: C CHECK THE DATA ITEM VALUES .... 02000104
204: IF ( IRN01 .EQ. IRNUM ) IVON01 = IVON01 + 1 02010104
205: C IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS 02020104
206: C RECORD NUMBERS GO FROM 1 TO 7 .... 02030104
207: IF ( IVON06 .EQ. 9 ) IVON01 = IVON01 + 1 02040104
208: C IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL 02050104
209: C TO THE INTEGER CONSTANT 9 .... 02060104
210: IF ( IVON07 .EQ. IRNUM ) IVON01 = IVON01 + 1 02070104
211: C IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD 02080104
212: C IN THE SET OF FOUR RECORDS .... 02090104
213: IF ( IRN02 .EQ. IRNUM ) IVON01 = IVON01 + 1 02100104
214: C THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..02110104
215: IF ( IVON08 .EQ. IRNUM + 1 ) IVON01 = IVON01 + 1 02120104
216: C IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.02130104
217: IF ( IRN03 .EQ. IRNUM ) IVON01 = IVON01 + 1 02140104
218: C AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS.... 02150104
219: IF ( IVON09 .EQ. IRNUM + 2 ) IVON01 = IVON01 + 1 02160104
220: C IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4. 02170104
221: IF ( IRN04 .EQ. IRNUM ) IVON01 = IVON01 + 1 02180104
222: C STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS. 02190104
223: IF ( IVON10 .EQ. IRNUM + 3 ) IVON01 = IVON01 + 1 02200104
224: C IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.02210104
225: IF ( IVON01 - 9 ) 20870, 10870, 20870 02220104
226: C WHEN IVON01 = 9 THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...02230104
227: 10870 IVPASS = IVPASS + 1 02240104
228: WRITE (I02,80001) IVTNUM 02250104
229: GO TO 881 02260104
230: 20870 IVFAIL = IVFAIL + 1 02270104
231: IVCOMP = IVON01 02280104
232: IVCORR = 9 02290104
233: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300104
234: 881 CONTINUE 02310104
235: IVTNUM = IVTNUM + 1 02320104
236: C INCREMENT THE TEST NUMBER.... 02330104
237: 932 CONTINUE 02340104
238: IF ( ICZERO ) 30870, 941, 30870 02350104
239: 30870 IVDELE = IVDELE + 1 02360104
240: WRITE (I02,80003) IVTNUM 02370104
241: 941 CONTINUE 02380104
242: IVTNUM = 94 02390104
243: C 02400104
244: C **** TEST 94 **** 02410104
245: C TEST 94 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST02420104
246: C SET OF 4 RECORDS ( 25,26,27,AND 28 ). 02430104
247: C THE VARIABLE IEND IS ACTUALLY IN THE RECORD NUMBERED 25. 02440104
248: C 02450104
249: IF (ICZERO) 30940, 940, 30940 02460104
250: 940 CONTINUE 02470104
251: IVCOMP = IEND 02480104
252: GO TO 40940 02490104
253: 30940 IVDELE = IVDELE + 1 02500104
254: WRITE (I02,80003) IVTNUM 02510104
255: IF (ICZERO) 40940, 951, 40940 02520104
256: 40940 IF ( IVCOMP - 9999 ) 20940, 10940, 20940 02530104
257: 10940 IVPASS = IVPASS + 1 02540104
258: WRITE (I02,80001) IVTNUM 02550104
259: GO TO 951 02560104
260: 20940 IVFAIL = IVFAIL + 1 02570104
261: IVCORR = 9999 02580104
262: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02590104
263: 951 CONTINUE 02600104
264: C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 05 02610104
265: C TO THE LINE PRINTER. 02620104
266: CDB** 02630104
267: C ILUN = I06 02640104
268: C ITOTR = 28 02650104
269: C IRLGN = 80 02660104
270: C7777 REWIND ILUN 02670104
271: C DO 7778 IRNUM = 1, ITOTR 02680104
272: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02690104
273: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02700104
274: C IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO ) GO TO 7779 02710104
275: C7778 CONTINUE 02720104
276: C GO TO 7782 02730104
277: C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 02740104
278: C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 02750104
279: C GO TO 7784 02760104
280: C7781 WRITE (I02,77703) ILUN,ITOTR 02770104
281: C GO TO 7784 02780104
282: C7782 WRITE (I02,77704) ILUN, ITOTR 02790104
283: C DO 7783 I = 1, 5 02800104
284: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02810104
285: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02820104
286: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 02830104
287: C7783 CONTINUE 02840104
288: C7784 GO TO 99999 02850104
289: CDE** 02860104
290: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02870104
291: 99999 CONTINUE 02880104
292: WRITE (I02,90002) 02890104
293: WRITE (I02,90006) 02900104
294: WRITE (I02,90002) 02910104
295: WRITE (I02,90002) 02920104
296: WRITE (I02,90007) 02930104
297: WRITE (I02,90002) 02940104
298: WRITE (I02,90008) IVFAIL 02950104
299: WRITE (I02,90009) IVPASS 02960104
300: WRITE (I02,90010) IVDELE 02970104
301: C 02980104
302: C 02990104
303: C TERMINATE ROUTINE EXECUTION 03000104
304: STOP 03010104
305: C 03020104
306: C FORMAT STATEMENTS FOR PAGE HEADERS 03030104
307: 90000 FORMAT (1H1) 03040104
308: 90002 FORMAT (1H ) 03050104
309: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03060104
310: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03070104
311: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 03080104
312: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03090104
313: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03100104
314: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03110104
315: C 03120104
316: C FORMAT STATEMENTS FOR RUN SUMMARIES 03130104
317: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03140104
318: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03150104
319: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03160104
320: C 03170104
321: C FORMAT STATEMENTS FOR TEST RESULTS 03180104
322: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03190104
323: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03200104
324: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03210104
325: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03220104
326: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03230104
327: C 03240104
328: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM104) 03250104
329: END 03260104
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.