![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM100.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 FM100.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. 00010100
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 00020100
6: C FM100 00030100
7: C 00040100
8: C THIS ROUTINE IS A TEST OF THE I FORMAT AND IS TAPE AND PRINTER00050100
9: C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060100
10: C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070100
11: C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080100
12: C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090100
13: C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100100
14: C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110100
15: C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120100
16: C INTEGER ARRAY FOR THE DUMP SECTION. 00130100
17: C 00140100
18: C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150100
19: C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS 00160100
20: C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS 00170100
21: C AND THE END OF FILE ON THE LAST RECORD. 00180100
22: C 00190100
23: C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00200100
24: C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00210100
25: C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00220100
26: C OF THE CONTINUATION LINE. 00230100
27: C 00240100
28: C REFERENCES 00250100
29: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260100
30: C X3.9-1978 00270100
31: C 00280100
32: C SECTION 8, SPECIFICATION STATEMENTS 00290100
33: C SECTION 9, DATA STATEMENT 00300100
34: C SECTION 11.10, DO STATEMENT 00310100
35: C SECTION 12, INPUT/OUTPUT STATEMENTS 00320100
36: C SECTION 12.8.2, INPUT/OUTPUT LIST 00330100
37: C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00340100
38: C SECTION 13, FORMAT STATEMENT 00350100
39: C SECTION 13.2.1, EDIT DESCRIPTORS 00360100
40: C SECTION 13.5.9.1, INTEGER EDITING 00370100
41: C 00380100
42: DIMENSION ITEST(30) 00390100
43: DIMENSION IDUMP(136) 00400100
44: CHARACTER*1 NINE,IDUMP 00410100
45: DATA NINE/'9'/ 00420100
46: C 00430100
47: 77701 FORMAT ( 80A1 ) 00440100
48: 77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O00450100
49: 1F ,I3,8H RECORDS) 00460100
50: 77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS) 00470100
51: 77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR00480100
52: 1DS) 00490100
53: 77705 FORMAT ( 1X,80A1) 00500100
54: 77706 FORMAT (10X,43HFILE I06 CREATED WITH 31 SEQUENTIAL RECORDS) 00510100
55: 77751 FORMAT (I3,I2,I2,I3,I3,I3,I4,I1,I1,I1,I1,I1,I1,I1,I1,I1,I1,I2,I2,I00520100
56: 13,I3,I4,I4,I4,I4,I4,I5,I5,I5,I5) 00530100
57: C 00540100
58: C 00550100
59: C ********************************************************** 00560100
60: C 00570100
61: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00580100
62: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00590100
63: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00600100
64: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00610100
65: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00620100
66: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00630100
67: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00640100
68: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00650100
69: C OF EXECUTING THESE TESTS. 00660100
70: C 00670100
71: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00680100
72: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00690100
73: C 00700100
74: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00710100
75: C 00720100
76: C DEPARTMENT OF THE NAVY 00730100
77: C FEDERAL COBOL COMPILER TESTING SERVICE 00740100
78: C WASHINGTON, D.C. 20376 00750100
79: C 00760100
80: C ********************************************************** 00770100
81: C 00780100
82: C 00790100
83: C 00800100
84: C INITIALIZATION SECTION 00810100
85: C 00820100
86: C INITIALIZE CONSTANTS 00830100
87: C ************** 00840100
88: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00850100
89: I01 = 5 00860100
90: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00870100
91: I02 = 6 00880100
92: C SYSTEM ENVIRONMENT SECTION 00890100
93: C 00900100
94: I01 = 5 00910100
95: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00920100
96: C (UNIT NUMBER FOR CARD READER). 00930100
97: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00940100
98: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00950100
99: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00960100
100: C 00970100
101: I02 = 6 00980100
102: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00990100
103: C (UNIT NUMBER FOR PRINTER). 01000100
104: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01010100
105: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01020100
106: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01030100
107: C 01040100
108: IVPASS=0 01050100
109: IVFAIL=0 01060100
110: IVDELE=0 01070100
111: ICZERO=0 01080100
112: C 01090100
113: C WRITE PAGE HEADERS 01100100
114: WRITE (I02,90000) 01110100
115: WRITE (I02,90001) 01120100
116: WRITE (I02,90002) 01130100
117: WRITE (I02, 90002) 01140100
118: WRITE (I02,90003) 01150100
119: WRITE (I02,90002) 01160100
120: WRITE (I02,90004) 01170100
121: WRITE (I02,90002) 01180100
122: WRITE (I02,90011) 01190100
123: WRITE (I02,90002) 01200100
124: WRITE (I02,90002) 01210100
125: WRITE (I02,90005) 01220100
126: WRITE (I02,90006) 01230100
127: WRITE (I02,90002) 01240100
128: C 01250100
129: C DEFAULT ASSIGNMENT FOR FILE 01 IS I06 = 7 01260100
130: I06 = 7 01270100
131: OPEN(UNIT=I06,ACCESS='SEQUENTIAL',FORM='FORMATTED') 01280100
132: CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061 01290100
133: C 01300100
134: C WRITE SECTION.... 01310100
135: C 01320100
136: C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS 01330100
137: C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY 01340100
138: C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01350100
139: C ROUTINE FM100 AND FOR PURPOSES OF IDENTIFICATION IS FILE 01. 01360100
140: C ALL OF THE DATA WITH THE EXCEPTION OF THE RECORD NUMBER - IRNUM , 01370100
141: C INTEGER VARIABLE ICON31 WHICH IS SET TO THE VALUE OF THE RECORD 01380100
142: C NUMBER, AND THE END OF FILE CHECK - IEOF IS SET BY INTEGER 01390100
143: C ASSIGNMENT STATEMENTS TO VARIOUS INTEGER CONSTANTS. 01400100
144: IPROG = 100 01410100
145: IFILE = 01 01420100
146: ILUN = I06 01430100
147: ITOTR = 31 01440100
148: IRLGN = 80 01450100
149: IEOF = 0000 01460100
150: ICON11 = 1 01470100
151: ICON12 = 2 01480100
152: ICON13 = 3 01490100
153: ICON14 = 4 01500100
154: ICON15 = 5 01510100
155: ICON16 = 6 01520100
156: ICON17 = 7 01530100
157: ICON18 = 8 01540100
158: ICON19 = 9 01550100
159: ICON10 = 0 01560100
160: ICON21 = 21 01570100
161: ICON22 = 22 01580100
162: ICON32 = 512 01590100
163: ICON41 = 9995 01600100
164: ICON42 = 9996 01610100
165: ICON43 = 9997 01620100
166: ICON44 = 9998 01630100
167: ICON45 = 9999 01640100
168: ICON51 = 32764 01650100
169: ICON52 = 32765 01660100
170: ICON53 = 32766 01670100
171: ICON54 = 32767 01680100
172: DO 12 IRNUM = 1, 31 01690100
173: ICON31 = IRNUM 01700100
174: IF ( IRNUM .EQ. 31 ) IEOF = 9999 01710100
175: WRITE(I06,77751)IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,ICON11,ICO01720100
176: 1N12,ICON13,ICON14,ICON15,ICON16,ICON17,ICON18,ICON19,ICON10,ICON2101730100
177: 2,ICON22,ICON31,ICON32,ICON41,ICON42,ICON43,ICON44,ICON45,ICON51,IC01740100
178: 3ON52,ICON53,ICON54 01750100
179: 12 CONTINUE 01760100
180: WRITE (I02,77706) 01770100
181: C 01780100
182: C REWIND SECTION 01790100
183: C 01800100
184: REWIND I06 01810100
185: C 01820100
186: C READ SECTION.... 01830100
187: C 01840100
188: IVTNUM = 1 01850100
189: C 01860100
190: C **** TEST 1 THRU TEST 8 **** 01870100
191: C TEST 1 THRU TEST 8 - THESE TESTS READ THE SEQUENTIAL FILE 01880100
192: C PREVIOUSLY WRITTEN ON LUN I06 AND CHECK THE FIRST AND EVERY FOURTH01890100
193: C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND 01900100
194: C SEVERAL VALUES WHICH SHOULD REMAIN CONSTANT FOR ALL OF THE 31 01910100
195: C RECORDS. 01920100
196: C 01930100
197: IRTST = 1 01940100
198: READ(I06,77751) ITEST 01950100
199: C READ THE FIRST RECORD.... 01960100
200: DO 23 I = 1, 8 01970100
201: IVON01 = 0 01980100
202: C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 1 THRU 801990100
203: IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 02000100
204: C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... 02010100
205: IF ( ITEST(8) .EQ. ICON11 ) IVON01 = IVON01 + 1 02020100
206: C THE ELEMENT (8) SHOULD EQUAL ICON11 = 1.... 02030100
207: IF ( ITEST(18) .EQ. ICON21 ) IVON01 = IVON01 + 1 02040100
208: C THE ELEMENT (18) SHOULD EQUAL ICON21 = 21.... 02050100
209: IF ( ITEST(20) .EQ. IRTST ) IVON01 = IVON01 + 1 02060100
210: C THE ELEMENT (20) SHOULD ALSO EQUAL THE RECORD NUMBER.... 02070100
211: IF ( ITEST(26) .EQ. ICON45 ) IVON01 = IVON01 + 1 02080100
212: C THE ELEMENT (26. SHOULD EQUAL ICON45 = 9999.... 02090100
213: IF ( ITEST(30) .EQ. ICON54 ) IVON01 = IVON01 + 1 02100100
214: C THE ELEMENT (30) SHOULD EQUAL ICON54 = 32767.... 02110100
215: IF ( IVON01 - 6 ) 20010, 10010, 20010 02120100
216: C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02130100
217: C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02140100
218: C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02150100
219: 10010 IVPASS = IVPASS + 1 02160100
220: WRITE (I02,80001) IVTNUM 02170100
221: GO TO 21 02180100
222: 20010 IVFAIL = IVFAIL + 1 02190100
223: IVCOMP = IVON01 02200100
224: IVCORR = 6 02210100
225: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02220100
226: 21 CONTINUE 02230100
227: IVTNUM = IVTNUM + 1 02240100
228: C INCREMENT THE TEST NUMBER.... 02250100
229: IF ( IVTNUM .EQ. 9 ) GO TO 91 02260100
230: C TAPE SHOULD BE AT RECORD NUMBER 29 FOR TEST 8 - DO NOT READ MORE02270100
231: C UNTIL TEST NUMBER NINE WHICH CHECKS RECORD NUMBER 30.... 02280100
232: DO 22 J = 1, 4 02290100
233: READ(I06,77751) ITEST 02300100
234: C READ FOUR RECORDS ON LUN I06.... 02310100
235: 22 CONTINUE 02320100
236: IRTST = IRTST + 4 02330100
237: C INCREMENT THE RECORD NUMBER COUNTER.... 02340100
238: 23 CONTINUE 02350100
239: IF (ICZERO) 30010, 91, 30010 02360100
240: 30010 IVDELE = IVDELE + 1 02370100
241: WRITE (I02,80003) IVTNUM 02380100
242: 91 CONTINUE 02390100
243: IVTNUM = 9 02400100
244: C 02410100
245: C **** TEST 9 **** 02420100
246: C TEST 9 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 30. 02430100
247: C 02440100
248: IF (ICZERO) 30090, 90, 30090 02450100
249: 90 CONTINUE 02460100
250: READ ( I06, 77751 ) ITEST 02470100
251: IVCOMP = ITEST(4) 02480100
252: GO TO 40090 02490100
253: 30090 IVDELE = IVDELE + 1 02500100
254: WRITE (I02,80003) IVTNUM 02510100
255: IF (ICZERO) 40090, 101, 40090 02520100
256: 40090 IF ( IVCOMP - 30 ) 20090, 10090, 20090 02530100
257: 10090 IVPASS = IVPASS + 1 02540100
258: WRITE (I02,80001) IVTNUM 02550100
259: GO TO 101 02560100
260: 20090 IVFAIL = IVFAIL + 1 02570100
261: IVCORR = 30 02580100
262: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02590100
263: 101 CONTINUE 02600100
264: IVTNUM = 10 02610100
265: C 02620100
266: C **** TEST 10 **** 02630100
267: C TEST 10 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 31. 02640100
268: C 02650100
269: IF (ICZERO) 30100, 100, 30100 02660100
270: 100 CONTINUE 02670100
271: READ ( I06,77751) ITEST 02680100
272: IVCOMP = ITEST(4) 02690100
273: GO TO 40100 02700100
274: 30100 IVDELE = IVDELE + 1 02710100
275: WRITE (I02,80003) IVTNUM 02720100
276: IF (ICZERO) 40100, 111, 40100 02730100
277: 40100 IF ( IVCOMP - 31 ) 20100, 10100, 20100 02740100
278: 10100 IVPASS = IVPASS + 1 02750100
279: WRITE (I02,80001) IVTNUM 02760100
280: GO TO 111 02770100
281: 20100 IVFAIL = IVFAIL + 1 02780100
282: IVCORR = 31 02790100
283: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02800100
284: 111 CONTINUE 02810100
285: IVTNUM = 11 02820100
286: C 02830100
287: C **** TEST 11 **** 02840100
288: C TEST 11 - THIS CHECKS FOR THE CORRECT END OF FILE CODE 9999 02850100
289: C ON RECORD NUMBER 31. 02860100
290: C 02870100
291: IF (ICZERO) 30110, 110, 30110 02880100
292: 110 CONTINUE 02890100
293: IVCOMP = ITEST(7) 02900100
294: GO TO 40110 02910100
295: 30110 IVDELE = IVDELE + 1 02920100
296: WRITE (I02,80003) IVTNUM 02930100
297: IF (ICZERO) 40110, 121, 40110 02940100
298: 40110 IF ( IVCOMP - 9999 ) 20110, 10110, 20110 02950100
299: 10110 IVPASS = IVPASS + 1 02960100
300: WRITE (I02,80001) IVTNUM 02970100
301: GO TO 121 02980100
302: 20110 IVFAIL = IVFAIL + 1 02990100
303: IVCORR = 9999 03000100
304: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03010100
305: 121 CONTINUE 03020100
306: C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 01 03030100
307: C TO THE LINE PRINTER. 03040100
308: CDB** 03050100
309: C ILUN = I06 03060100
310: C ITOTR = 31 03070100
311: C IRLGN = 80 03080100
312: C7777 REWIND ILUN 03090100
313: C DO 7778 IRNUM = 1, ITOTR 03100100
314: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03110100
315: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03120100
316: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 03130100
317: C7778 CONTINUE 03140100
318: C GO TO 7782 03150100
319: C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 03160100
320: C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03170100
321: C GO TO 7784 03180100
322: C7781 WRITE (I02,77703) ILUN,ITOTR 03190100
323: C GO TO 7784 03200100
324: C7782 WRITE (I02,77704) ILUN, ITOTR 03210100
325: C DO 7783 I = 1, 5 03220100
326: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03230100
327: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03240100
328: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03250100
329: C7783 CONTINUE 03260100
330: C7784 GO TO 99999 03270100
331: CDE** 03280100
332: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03290100
333: 99999 CONTINUE 03300100
334: WRITE (I02,90002) 03310100
335: WRITE (I02,90006) 03320100
336: WRITE (I02,90002) 03330100
337: WRITE (I02,90002) 03340100
338: WRITE (I02,90007) 03350100
339: WRITE (I02,90002) 03360100
340: WRITE (I02,90008) IVFAIL 03370100
341: WRITE (I02,90009) IVPASS 03380100
342: WRITE (I02,90010) IVDELE 03390100
343: C 03400100
344: C 03410100
345: C TERMINATE ROUTINE EXECUTION 03420100
346: STOP 03430100
347: C 03440100
348: C FORMAT STATEMENTS FOR PAGE HEADERS 03450100
349: 90000 FORMAT (1H1) 03460100
350: 90002 FORMAT (1H ) 03470100
351: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03480100
352: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03490100
353: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 03500100
354: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03510100
355: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03520100
356: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03530100
357: C 03540100
358: C FORMAT STATEMENTS FOR RUN SUMMARIES 03550100
359: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03560100
360: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03570100
361: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03580100
362: C 03590100
363: C FORMAT STATEMENTS FOR TEST RESULTS 03600100
364: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03610100
365: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03620100
366: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03630100
367: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03640100
368: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03650100
369: C 03660100
370: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM100) 03670100
371: END 03680100
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.