![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM105.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 FM105.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. 00010105
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 00020105
6: C FM105 00030105
7: C 00040105
8: C FM105 TESTS REPEATED ( ) FORMAT FIELDS AND IS TAPE AND PRINTER00050105
9: C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060105
10: C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070105
11: C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080105
12: C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090105
13: C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100105
14: C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110105
15: C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120105
16: C INTEGER ARRAY FOR THE DUMP SECTION. 00130105
17: C 00140105
18: C ROUTINE FM105 IS EXACTLY LIKE ROUTINE FM104 EXCEPT THAT 00150105
19: C FORMAT NUMBERS 77751 AND 77752 HAVE BEEN CHANGED TO USE THREE (3) 00160105
20: C REPEATED FIELDS, I.E. ... 3(/ ... ) THIS SHOULD STILL 00170105
21: C MAKE THE ROUTINE WRITE AND THEN READ FOUR (4) 80 CHARACTER 00180105
22: C RECORDS FOR EACH SINGLE WRITE OR READ STATEMENT. OTHER FORMAT 00190105
23: C CONVERSIONS USED ARE THE X AND I FORMAT FIELDS. BECAUSE OF THE 00200105
24: C NUMBER OF CHARACTERS TO BE WRITTEN OR READ IN EACH SET OF FOUR 00210105
25: C RECORDS, THE ENTIRE REPEATED FIELD IS USED. 00220105
26: C 00230105
27: C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00240105
28: C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00250105
29: C CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS 00260105
30: C AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED. 00270105
31: C 00280105
32: C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00290105
33: C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00300105
34: C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00310105
35: C OF THE CONTINUATION LINE. 00320105
36: C 00330105
37: C REFERENCES 00340105
38: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00350105
39: C X3.9-1978 00360105
40: C 00370105
41: C SECTION 8, SPECIFICATION STATEMENTS 00380105
42: C SECTION 9, DATA STATEMENT 00390105
43: C SECTION 11.10, DO STATEMENT 00400105
44: C SECTION 12, INPUT/OUTPUT STATEMENTS 00410105
45: C SECTION 12.8.2, INPUT/OUTPUT LIST 00420105
46: C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00430105
47: C SECTION 13, FORMAT STATEMENT 00440105
48: C SECTION 13.2.1, EDIT DESCRIPTORS 00450105
49: C SECTION 13.5.9.1, INTEGER EDITING 00460105
50: C 00470105
51: C 00480105
52: DIMENSION IPREM(7), IADN11(57) 00490105
53: DIMENSION IDUMP(136) 00500105
54: CHARACTER*1 NINE,IZERO,IDUMP 00510105
55: DATA NINE/'9'/, IZERO/'0'/ 00520105
56: C 00530105
57: 77701 FORMAT ( 80A1 ) 00540105
58: 77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O00550105
59: 1F ,I3,8H RECORDS) 00560105
60: 77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS) 00570105
61: 77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR00580105
62: 1DS) 00590105
63: 77705 FORMAT ( 1X,80A1) 00600105
64: 77706 FORMAT (10X,43HFILE I08 CREATED WITH 28 SEQUENTIAL RECORDS) 00610105
65: 77751 FORMAT ( I3,2(I2),3(I3),I4,57(I1),I3,3(/I3,2(I2),3(I3),I4,57(I1),I00620105
66: 13) ) 00630105
67: 77752 FORMAT ( 7(1X),I3,6(1X),I4,I1,56(1X),I3,3(/7(1X),I3,67(1X),I3) ) 00640105
68: C 00650105
69: C 00660105
70: C ********************************************************** 00670105
71: C 00680105
72: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00690105
73: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00700105
74: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00710105
75: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00720105
76: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00730105
77: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00740105
78: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00750105
79: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00760105
80: C OF EXECUTING THESE TESTS. 00770105
81: C 00780105
82: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00790105
83: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00800105
84: C 00810105
85: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00820105
86: C 00830105
87: C DEPARTMENT OF THE NAVY 00840105
88: C FEDERAL COBOL COMPILER TESTING SERVICE 00850105
89: C WASHINGTON, D.C. 20376 00860105
90: C 00870105
91: C ********************************************************** 00880105
92: C 00890105
93: C 00900105
94: C 00910105
95: C INITIALIZATION SECTION 00920105
96: C 00930105
97: C INITIALIZE CONSTANTS 00940105
98: C ************** 00950105
99: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00960105
100: I01 = 5 00970105
101: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00980105
102: I02 = 6 00990105
103: C SYSTEM ENVIRONMENT SECTION 01000105
104: C 01010105
105: I01 = 5 01020105
106: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01030105
107: C (UNIT NUMBER FOR CARD READER). 01040105
108: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01050105
109: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01060105
110: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01070105
111: C 01080105
112: I02 = 6 01090105
113: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01100105
114: C (UNIT NUMBER FOR PRINTER). 01110105
115: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01120105
116: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01130105
117: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01140105
118: C 01150105
119: IVPASS=0 01160105
120: IVFAIL=0 01170105
121: IVDELE=0 01180105
122: ICZERO=0 01190105
123: C 01200105
124: C WRITE PAGE HEADERS 01210105
125: WRITE (I02,90000) 01220105
126: WRITE (I02,90001) 01230105
127: WRITE (I02,90002) 01240105
128: WRITE (I02, 90002) 01250105
129: WRITE (I02,90003) 01260105
130: WRITE (I02,90002) 01270105
131: WRITE (I02,90004) 01280105
132: WRITE (I02,90002) 01290105
133: WRITE (I02,90011) 01300105
134: WRITE (I02,90002) 01310105
135: WRITE (I02,90002) 01320105
136: WRITE (I02,90005) 01330105
137: WRITE (I02,90006) 01340105
138: WRITE (I02,90002) 01350105
139: C 01360105
140: C DEFAULT ASSIGNMENT FOR FILE 06 IS I08 = 7 01370105
141: I08 = 7 01380105
142: OPEN(UNIT=I08,ACCESS='SEQUENTIAL',FORM='FORMATTED') 01390105
143: CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081 01400105
144: C 01410105
145: C WRITE SECTION.... 01420105
146: C 01430105
147: C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS 01440105
148: C 80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY 01450105
149: C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01460105
150: C ROUTINE FM105 AND FOR PURPOSES OF IDENTIFICATION IS FILE 06. 01470105
151: C SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4) 01480105
152: C RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT. ALL FOUR 01490105
153: C OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20 01500105
154: C CHARACTER PREAMBLE. THE INTEGER STORED IN CHARACTER POSITIONS 01510105
155: C 78 - 80 WILL EQUAL THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR 01520105
156: C THE FOUR RECORD SET RESPECTIVELY.. THE INTEGER ARRAY ELEMENTS 01530105
157: C IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9. 01540105
158: IPROG = 105 01550105
159: IFILE = 06 01560105
160: ILUN = I08 01570105
161: ITOTR = 28 01580105
162: IRLGN = 80 01590105
163: IEOF = 0000 01600105
164: C SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF.. 01610105
165: IPREM(1) = IPROG 01620105
166: IPREM(2) = IFILE 01630105
167: IPREM(3) = ILUN 01640105
168: IPREM(5) = ITOTR 01650105
169: IPREM(6) = IRLGN 01660105
170: C SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9 01670105
171: DO 10 I = 1, 57 01680105
172: IADN11(I) = 9 01690105
173: 10 CONTINUE 01700105
174: DO 952 IRNUM = 1, 7 01710105
175: IF ( IRNUM .EQ. 7 ) IEOF = 9999 01720105
176: IPREM(4) = IRNUM 01730105
177: IPREM(7) = IEOF 01740105
178: IVON02 = IRNUM 01750105
179: IVON03 = IRNUM + 1 01760105
180: IVON04 = IRNUM + 2 01770105
181: IVON05 = IRNUM + 3 01780105
182: WRITE ( I08, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101790105
183: 11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON01800105
184: 205 01810105
185: 952 CONTINUE 01820105
186: WRITE (I02,77706) 01830105
187: C 01840105
188: C REWIND SECTION 01850105
189: C 01860105
190: REWIND I08 01870105
191: C 01880105
192: C READ SECTION.... 01890105
193: C 01900105
194: IVTNUM = 95 01910105
195: C 01920105
196: C **** TEST 95 THRU TEST 101 **** 01930105
197: C TEST 95 THRU 101 - THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS 01940105
198: C CREATED AS FILE I08 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS, 01950105
199: C AND THE END OF FILE INDICATOR. 01960105
200: C 01970105
201: DO 962 IRNUM = 1, 7 01980105
202: IVON01 = 0 01990105
203: C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 95 - 10102000105
204: READ ( I08, 77752 ) IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,02010105
205: 1IVON09,IRN04,IVON10 02020105
206: C READ THE FILE I08 - NOTE, FOUR RECORDS ARE READ IN EACH SINGLE 02030105
207: C READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO 02040105
208: C CREATE THE FILE. 02050105
209: C 02060105
210: C CHECK THE DATA ITEM VALUES .... 02070105
211: IF ( IRN01 .EQ. IRNUM ) IVON01 = IVON01 + 1 02080105
212: C IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS 02090105
213: C RECORD NUMBERS GO FROM 1 TO 7 .... 02100105
214: IF ( IVON06 .EQ. 9 ) IVON01 = IVON01 + 1 02110105
215: C IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL 02120105
216: C TO THE INTEGER CONSTANT 9 .... 02130105
217: IF ( IVON07 .EQ. IRNUM ) IVON01 = IVON01 + 1 02140105
218: C IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD 02150105
219: C IN THE SET OF FOUR RECORDS .... 02160105
220: IF ( IRN02 .EQ. IRNUM ) IVON01 = IVON01 + 1 02170105
221: C THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..02180105
222: IF ( IVON08 .EQ. IRNUM + 1 ) IVON01 = IVON01 + 1 02190105
223: C IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.02200105
224: IF ( IRN03 .EQ. IRNUM ) IVON01 = IVON01 + 1 02210105
225: C AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS.... 02220105
226: IF ( IVON09 .EQ. IRNUM + 2 ) IVON01 = IVON01 + 1 02230105
227: C IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4. 02240105
228: IF ( IRN04 .EQ. IRNUM ) IVON01 = IVON01 + 1 02250105
229: C STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS. 02260105
230: IF ( IVON10 .EQ. IRNUM + 3 ) IVON01 = IVON01 + 1 02270105
231: C IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.02280105
232: IF ( IVON01 - 9 ) 20960, 10960, 20960 02290105
233: C WHEN IVON01 = 9 THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...02300105
234: 10960 IVPASS = IVPASS + 1 02310105
235: WRITE (I02,80001) IVTNUM 02320105
236: GO TO 971 02330105
237: 20960 IVFAIL = IVFAIL + 1 02340105
238: IVCOMP = IVON01 02350105
239: IVCORR = 9 02360105
240: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02370105
241: 971 CONTINUE 02380105
242: IVTNUM = IVTNUM + 1 02390105
243: C INCREMENT THE TEST NUMBER.... 02400105
244: 962 CONTINUE 02410105
245: IF ( ICZERO ) 30960, 1021, 30960 02420105
246: 30960 IVDELE = IVDELE + 1 02430105
247: WRITE (I02,80003) IVTNUM 02440105
248: 1021 CONTINUE 02450105
249: IVTNUM = 102 02460105
250: C 02470105
251: C **** TEST 102 **** 02480105
252: C TEST 102 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST02490105
253: C SET OF 4 RECORDS ( 25,26,27,AND 28 ). 02500105
254: C THE VARIABLE IEND IS ACTUALLY IN THE RECORD NUMBERED 25. 02510105
255: C 02520105
256: IF (ICZERO) 31020, 1020, 31020 02530105
257: 1020 CONTINUE 02540105
258: IVCOMP = IEND 02550105
259: GO TO 41020 02560105
260: 31020 IVDELE = IVDELE + 1 02570105
261: WRITE (I02,80003) IVTNUM 02580105
262: IF (ICZERO) 41020, 1031, 41020 02590105
263: 41020 IF ( IVCOMP - 9999 ) 21020, 11020, 21020 02600105
264: 11020 IVPASS = IVPASS + 1 02610105
265: WRITE (I02,80001) IVTNUM 02620105
266: GO TO 1031 02630105
267: 21020 IVFAIL = IVFAIL + 1 02640105
268: IVCORR = 9999 02650105
269: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02660105
270: 1031 CONTINUE 02670105
271: C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 06 02680105
272: C TO THE LINE PRINTER. 02690105
273: CDB** 02700105
274: C ILUN = I08 02710105
275: C ITOTR = 28 02720105
276: C IRLGN = 80 02730105
277: C7777 REWIND ILUN 02740105
278: C DO 7778 IRNUM = 1, ITOTR 02750105
279: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02760105
280: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02770105
281: C IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO ) GO TO 7779 02780105
282: C7778 CONTINUE 02790105
283: C GO TO 7782 02800105
284: C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 02810105
285: C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 02820105
286: C GO TO 7784 02830105
287: C7781 WRITE (I02,77703) ILUN,ITOTR 02840105
288: C GO TO 7784 02850105
289: C7782 WRITE (I02,77704) ILUN, ITOTR 02860105
290: C DO 7783 I = 1, 5 02870105
291: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02880105
292: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02890105
293: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 02900105
294: C7783 CONTINUE 02910105
295: C7784 GO TO 99999 02920105
296: CDE** 02930105
297: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02940105
298: 99999 CONTINUE 02950105
299: WRITE (I02,90002) 02960105
300: WRITE (I02,90006) 02970105
301: WRITE (I02,90002) 02980105
302: WRITE (I02,90002) 02990105
303: WRITE (I02,90007) 03000105
304: WRITE (I02,90002) 03010105
305: WRITE (I02,90008) IVFAIL 03020105
306: WRITE (I02,90009) IVPASS 03030105
307: WRITE (I02,90010) IVDELE 03040105
308: C 03050105
309: C 03060105
310: C TERMINATE ROUTINE EXECUTION 03070105
311: STOP 03080105
312: C 03090105
313: C FORMAT STATEMENTS FOR PAGE HEADERS 03100105
314: 90000 FORMAT (1H1) 03110105
315: 90002 FORMAT (1H ) 03120105
316: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03130105
317: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03140105
318: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 03150105
319: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03160105
320: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03170105
321: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03180105
322: C 03190105
323: C FORMAT STATEMENTS FOR RUN SUMMARIES 03200105
324: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03210105
325: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03220105
326: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03230105
327: C 03240105
328: C FORMAT STATEMENTS FOR TEST RESULTS 03250105
329: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03260105
330: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03270105
331: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03280105
332: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03290105
333: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03300105
334: C 03310105
335: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM105) 03320105
336: END 03330105
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.