|
|
1.1 root 1: C***********************************************************************00010917
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***** FORTRAN 77 00020917
6: C***** FM917 00030917
7: C***** INQU4 - (433) 00040917
8: C***** 00050917
9: C***********************************************************************00060917
10: C***** GENERAL PURPOSE ANS REF 00070917
11: C***** TEST INQUIRE BY UNIT ON DIRECT, UNFORMATTED FILE 12.10.3 00080917
12: C***** 00090917
13: C***** THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A 00100917
14: C***** UNIT THAT IS CONNECTED FOR DIRECT, UNFORMATTED ACCESS 00110917
15: C***** (ANS REF. 12.2.4.2 AND 12.9.5.1) 00120917
16: C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00130917
17: C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00140917
18: C***** THIS SEGMENT TESTS THAT AN INQUIRE IS PERFORMED CORRECTLY 00150917
19: C***** BEFORE READING OR WRITING TO THE FILE, AFTER WRITING TO 00160917
20: C***** THE FILE, AND AFTER READING FROM THE FILE. 00170917
21: C***** 00180917
22: C***** NOTE: 00190917
23: C***** AN INQUIRE STATEMENT IS NEEDED TO TEST THE READ AND 00200917
24: C***** WRITE OF MORE THAN A SINGLE RECORD AT A TIME, IN ORDER TO 00210917
25: C***** DETERMINE THAT THE RECORD NUMBER IS ADVANCED THE CORRECT 00220917
26: C***** NUMBER (ONE MORE THAN THE RECORD NUMBER LAST READ OR WRITTEN).00230917
27: C***** THIS TEST WILL BE PERFORMED IN THE SEGMENTS WHICH TEST 00240917
28: C***** DIRECT ACCESS FILES - SEGMENT DIRAF3 (412). 00250917
29: C***********************************************************************00260917
30: C***** 00270917
31: CBB** ********************** BBCCOMNT **********************************00280917
32: C**** 00290917
33: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00300917
34: C**** VERSION 2.0 00310917
35: C**** 00320917
36: C**** 00330917
37: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00340917
38: C**** GENERAL SERVICES ADMINISTRATION 00350917
39: C**** FEDERAL SOFTWARE TESTING CENTER 00360917
40: C**** 5203 LEESBURG PIKE, SUITE 1100 00370917
41: C**** FALLS CHURCH, VA. 22041 00380917
42: C**** 00390917
43: C**** (703) 756-6153 00400917
44: C**** 00410917
45: CBE** ********************** BBCCOMNT **********************************00420917
46: C***** 00430917
47: LOGICAL AVB, BVB 00440917
48: CHARACTER*10 B10VK, D10VK, E11VK*11, G10VK 00450917
49: C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00460917
50: CBB** ********************** BBCINITA **********************************00470917
51: C**** SPECIFICATION STATEMENTS 00480917
52: C**** 00490917
53: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00500917
54: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00510917
55: CBE** ********************** BBCINITA **********************************00520917
56: CBB** ********************** BBCINITB **********************************00530917
57: C**** INITIALIZE SECTION 00540917
58: DATA ZVERS, ZVERSD, ZDATE 00550917
59: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00560917
60: DATA ZCOMPL, ZNAME, ZTAPE 00570917
61: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00580917
62: DATA ZPROJ, ZTAPED, ZPROG 00590917
63: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00600917
64: DATA REMRKS /' '/ 00610917
65: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00620917
66: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00630917
67: C**** 00640917
68: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00650917
69: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00660917
70: CZ03 ZPROG = 'PROGRAM NAME' 00670917
71: ZDATE = '07-Nov-85 ' *RP
72: ZCOMPL = 'CCI 5.2 ' *RP
73: ZPROJ = 'TC-85- -410' *RP
74: ZNAME = ' ' *RP
75: ZTAPE = ' ' *RP
76: ZTAPED = '850703 ' *RP
77: C 00740917
78: IVPASS = 0 00750917
79: IVFAIL = 0 00760917
80: IVDELE = 0 00770917
81: IVINSP = 0 00780917
82: IVTOTL = 0 00790917
83: IVTOTN = 0 00800917
84: ICZERO = 0 00810917
85: C 00820917
86: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00830917
87: I01 = 05 00840917
88: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00850917
89: I02 = 06 00860917
90: C 00870917
91: I01 = 5 00880917
92: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00890917
93: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00900917
94: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00910917
95: C 00920917
96: I02 = 6 00930917
97: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00940917
98: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00950917
99: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00960917
100: C 00970917
101: CBE** ********************** BBCINITB **********************************00980917
102: C***** 00990917
103: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 01000917
104: C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 01010917
105: C***** DIRECT, UNFORMATTED FILE. 01020917
106: C***** 01030917
107: C I12 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE. 01040917
108: I12 = 14 01050917
109: OPEN(UNIT=I12,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=40) 01060917
110: C SPECIFYING I12 = NN OVERRIDES THE DEFAULT I12 = 14. 01070917
111: C***** 01080917
112: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01090917
113: C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 01100917
114: C***** UNFORMATTED FILE. 01110917
115: C***** 01120917
116: C***** 01130917
117: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS 01140917
118: C***** NOT A VALID RECORD LENGTH. 01150917
119: MVI = 40 01160917
120: C***** 01170917
121: NUVI = I02 01180917
122: IOVI = I12 01190917
123: ZPROG = 'FM917' 01200917
124: IVTOTL = 3 01210917
125: CBB** ********************** BBCHED0A **********************************01220917
126: C**** 01230917
127: C**** WRITE REPORT TITLE 01240917
128: C**** 01250917
129: WRITE (I02, 90002) 01260917
130: WRITE (I02, 90006) 01270917
131: WRITE (I02, 90007) 01280917
132: WRITE (I02, 90008) ZVERS, ZVERSD 01290917
133: WRITE (I02, 90009) ZPROG, ZPROG 01300917
134: WRITE (I02, 90010) ZDATE, ZCOMPL 01310917
135: CBE** ********************** BBCHED0A **********************************01320917
136: C***** 01330917
137: WRITE(NUVI,43300) 01340917
138: 43300 FORMAT(1H , / 30H INQU4 - (433) INQUIRE BY UNIT// 01350917
139: 1 31H DIRECT ACCESS UNFORMATTED FILE// 01360917
140: 2 19H ANS REF. - 12.10.3) 01370917
141: CBB** ********************** BBCHED0B **********************************01380917
142: C**** WRITE DETAIL REPORT HEADERS 01390917
143: C**** 01400917
144: WRITE (I02,90004) 01410917
145: WRITE (I02,90004) 01420917
146: WRITE (I02,90013) 01430917
147: WRITE (I02,90014) 01440917
148: WRITE (I02,90015) IVTOTL 01450917
149: CBE** ********************** BBCHED0B **********************************01460917
150: C***** 01470917
151: C***** OPEN FILE 01480917
152: OPEN(UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, FORM='UNFORMATTED') 01490917
153: C***** 01500917
154: CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN) 01510917
155: IVTNUM = 1 01520917
156: INQUIRE(UNIT=IOVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01530917
157: 1 ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 01540917
158: 2 FORM=E11VK, UNFORMATTED=G10VK, ERR=20014,IOSTAT=IVI) 01550917
159: C***** 01560917
160: IF (IVI .NE. 0) GO TO 20010 01570917
161: IF (.NOT. AVB) GO TO 20010 01580917
162: IF (.NOT. BVB) GO TO 20010 01590917
163: IF (JVI .NE. IOVI) GO TO 20010 01600917
164: IF (B10VK .NE. 'DIRECT') GO TO 20010 01610917
165: IF (D10VK .NE. 'YES') GO TO 20010 01620917
166: IF (KVI .NE. MVI) GO TO 20010 01630917
167: IF (LVI .NE. 1) GO TO 20010 01640917
168: IF (E11VK .NE. 'UNFORMATTED') GO TO 20010 01650917
169: IF (G10VK .NE. 'YES' ) GO TO 20010 01660917
170: WRITE (NUVI, 80002) IVTNUM 01670917
171: IVPASS = IVPASS + 1 01680917
172: GO TO 0011 01690917
173: 20014 CONTINUE 01700917
174: WRITE (NUVI, 20015) IVTNUM 01710917
175: 20015 FORMAT (1H ,2X,I3,4X,5H FAIL,12X, 01720917
176: 1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/) 01730917
177: GO TO 20016 01740917
178: 20010 CONTINUE 01750917
179: WRITE (NUVI, 20011) IVTNUM 01760917
180: 20011 FORMAT(1H ,2X,I3,4X,5H FAIL,12X, 01770917
181: 1 29HERROR IN AN INQUIRE SPECIFIER/) 01780917
182: 20016 IVFAIL = IVFAIL + 1 01790917
183: WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,D10VK, 01800917
184: 1 KVI,LVI,E11VK,G10VK 01810917
185: 20012 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1, 01820917
186: 1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/ 01830917
187: 2 1H ,26X,7HACCESS=,A10,9H, DIRECT=,A3,7H, RECL=, 01840917
188: 3 I4,1H,/1H ,26X,8HNEXTREC=,I4,7H, FORM=, 01850917
189: 4 A11,1H,/1H ,26X,12HUNFORMATTED=,A3) 01860917
190: WRITE (NUVI, 20013) IOVI, MVI 01870917
191: 20013 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, , 01880917
192: 1 17HOPENED=T, NUMBER=,I4,1H,/ 01890917
193: 2 1H ,26X,32HACCESS=DIRECT, DIRECT=YES, RECL=, 01900917
194: 3 I4,1H,/1H ,26X,28HNEXTREC=1, FORM=UNFORMATTED,/ 01910917
195: 4 1H ,26X,15HUNFORMATTED=YES) 01920917
196: 0011 CONTINUE 01930917
197: C***** 01940917
198: C***** WRITE A RECORD TO FILE 01950917
199: WRITE(IOVI, REC=1) JVI 01960917
200: C***** 01970917
201: CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE) 01980917
202: IVTNUM = 2 01990917
203: C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC 02000917
204: C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED 02010917
205: INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 02020917
206: 1 ERR=20024, IOSTAT=IVI) 02030917
207: C***** 02040917
208: IF (IVI .NE. 0) GO TO 20020 02050917
209: IF (D10VK .NE. 'YES') GO TO 20020 02060917
210: IF (KVI .NE. MVI) GO TO 20020 02070917
211: IF (LVI .NE. 2) GO TO 20020 02080917
212: WRITE (NUVI, 80002) IVTNUM 02090917
213: IVPASS = IVPASS + 1 02100917
214: GO TO 0021 02110917
215: 20024 CONTINUE 02120917
216: WRITE (NUVI, 20025) IVTNUM 02130917
217: 20025 FORMAT (1H ,2X,I3,4X,5H FAIL,12X, 02140917
218: 1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/) 02150917
219: GO TO 20026 02160917
220: 20020 CONTINUE 02170917
221: WRITE (NUVI, 20021) IVTNUM 02180917
222: 20021 FORMAT(1H ,2X,I3,4X,5H FAIL,12X, 02190917
223: 1 29HERROR IN AN INQUIRE SPECIFIER/) 02200917
224: 20026 IVFAIL = IVFAIL + 1 02210917
225: WRITE (NUVI, 20022) IVI,D10VK,KVI,LVI 02220917
226: 20022 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,9H, DIRECT=,A3, 02230917
227: 1 7H ,RECL=,I4,10H, NEXTREC=,I4) 02240917
228: WRITE (NUVI, 20023) MVI 02250917
229: 20023 FORMAT (1H ,16X,10HCORRECT: ,22HIOSTAT=0, DIRECT=YES, , 02260917
230: 1 5HRECL=,I4,14H, NEXTREC= 2) 02270917
231: 0021 CONTINUE 02280917
232: C***** 02290917
233: C***** READ A RECORD FROM FILE 02300917
234: C***** 02310917
235: READ(IOVI, REC=1) JVI 02320917
236: C***** 02330917
237: CT003* TEST 3 - THIRD INQUIRE (AFTER READ) 02340917
238: IVTNUM = 3 02350917
239: C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC 02360917
240: C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED 02370917
241: INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 02380917
242: 1 ERR=20034, IOSTAT=IVI) 02390917
243: C***** 02400917
244: IF (IVI .NE. 0) GO TO 20030 02410917
245: IF (D10VK .NE. 'YES') GO TO 20030 02420917
246: IF (KVI .NE. MVI) GO TO 20030 02430917
247: IF (LVI .NE. 2) GO TO 20030 02440917
248: WRITE (NUVI, 80002) IVTNUM 02450917
249: IVPASS = IVPASS + 1 02460917
250: GO TO 0031 02470917
251: 20034 CONTINUE 02480917
252: WRITE (NUVI, 20035) IVTNUM 02490917
253: 20035 FORMAT (1H ,2X,I3,4X,5H FAIL,12X, 02500917
254: 1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/) 02510917
255: GO TO 20036 02520917
256: 20030 CONTINUE 02530917
257: WRITE (NUVI, 20031) IVTNUM 02540917
258: 20031 FORMAT(1H ,2X,I3,4X,5H FAIL,12X, 02550917
259: 1 29HERROR IN AN INQUIRE SPECIFIER/) 02560917
260: 20036 IVFAIL = IVFAIL + 1 02570917
261: WRITE (NUVI, 20032) IVI,D10VK,KVI,LVI 02580917
262: 20032 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,9H, DIRECT=,A3, 02590917
263: 1 7H ,RECL=,I4,10H, NEXTREC=,I4) 02600917
264: WRITE (NUVI, 20023) MVI 02610917
265: 20033 FORMAT (1H ,16X,10HCORRECT: ,22HIOSTAT=0, DIRECT=YES, , 02620917
266: 1 5HRECL=,I4,14H, NEXTREC= 2) 02630917
267: 0031 CONTINUE 02640917
268: C***** 02650917
269: CLOSE(UNIT=IOVI, STATUS='DELETE') 02660917
270: C***** 02670917
271: CBB** ********************** BBCSUM0 **********************************02680917
272: C**** WRITE OUT TEST SUMMARY 02690917
273: C**** 02700917
274: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02710917
275: WRITE (I02, 90004) 02720917
276: WRITE (I02, 90014) 02730917
277: WRITE (I02, 90004) 02740917
278: WRITE (I02, 90020) IVPASS 02750917
279: WRITE (I02, 90022) IVFAIL 02760917
280: WRITE (I02, 90024) IVDELE 02770917
281: WRITE (I02, 90026) IVINSP 02780917
282: WRITE (I02, 90028) IVTOTN, IVTOTL 02790917
283: CBE** ********************** BBCSUM0 **********************************02800917
284: CBB** ********************** BBCFOOT0 **********************************02810917
285: C**** WRITE OUT REPORT FOOTINGS 02820917
286: C**** 02830917
287: WRITE (I02,90016) ZPROG, ZPROG 02840917
288: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02850917
289: WRITE (I02,90019) 02860917
290: CBE** ********************** BBCFOOT0 **********************************02870917
291: CBB** ********************** BBCFMT0A **********************************02880917
292: C**** FORMATS FOR TEST DETAIL LINES 02890917
293: C**** 02900917
294: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 02910917
295: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 02920917
296: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 02930917
297: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 02940917
298: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 02950917
299: 1I6,/,1H ,15X,10HCORRECT= ,I6) 02960917
300: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02970917
301: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 02980917
302: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02990917
303: 1A21,/,1H ,16X,10HCORRECT= ,A21) 03000917
304: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 03010917
305: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 03020917
306: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 03030917
307: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 03040917
308: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 03050917
309: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 03060917
310: 80050 FORMAT (1H ,48X,A31) 03070917
311: CBE** ********************** BBCFMT0A **********************************03080917
312: CBB** ********************** BBCFMT0B **********************************03090917
313: C**** FORMAT STATEMENTS FOR PAGE HEADERS 03100917
314: C**** 03110917
315: 90002 FORMAT (1H1) 03120917
316: 90004 FORMAT (1H ) 03130917
317: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 03140917
318: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03150917
319: 90008 FORMAT (1H ,21X,A13,A17) 03160917
320: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 03170917
321: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 03180917
322: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 03190917
323: 1 7X,7HREMARKS,24X) 03200917
324: 90014 FORMAT (1H ,46H----------------------------------------------, 03210917
325: 1 33H---------------------------------) 03220917
326: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 03230917
327: C**** 03240917
328: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03250917
329: C**** 03260917
330: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 03270917
331: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 03280917
332: 1 A13) 03290917
333: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 03300917
334: C**** 03310917
335: C**** FORMAT STATEMENTS FOR RUN SUMMARY 03320917
336: C**** 03330917
337: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 03340917
338: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 03350917
339: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 03360917
340: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 03370917
341: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 03380917
342: CBE** ********************** BBCFMT0B **********************************03390917
343: C***** 03400917
344: C***** END OF TEST SEGMENT 433 03410917
345: STOP 03420917
346: END 03430917
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.