blob: 5f4af10f793aef3ad04a817c474562e0537bfdb0 [file] [log] [blame]
PROGRAM FM917
C***********************************************************************00010917
C***** FORTRAN 77 00020917
C***** FM917 00030917
C***** INQU4 - (433) 00040917
C***** 00050917
C***********************************************************************00060917
C***** GENERAL PURPOSE ANS REF 00070917
C***** TEST INQUIRE BY UNIT ON DIRECT, UNFORMATTED FILE 12.10.3 00080917
C***** 00090917
C***** THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A 00100917
C***** UNIT THAT IS CONNECTED FOR DIRECT, UNFORMATTED ACCESS 00110917
C***** (ANS REF. 12.2.4.2 AND 12.9.5.1) 00120917
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00130917
C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00140917
C***** THIS SEGMENT TESTS THAT AN INQUIRE IS PERFORMED CORRECTLY 00150917
C***** BEFORE READING OR WRITING TO THE FILE, AFTER WRITING TO 00160917
C***** THE FILE, AND AFTER READING FROM THE FILE. 00170917
C***** 00180917
C***** NOTE: 00190917
C***** AN INQUIRE STATEMENT IS NEEDED TO TEST THE READ AND 00200917
C***** WRITE OF MORE THAN A SINGLE RECORD AT A TIME, IN ORDER TO 00210917
C***** DETERMINE THAT THE RECORD NUMBER IS ADVANCED THE CORRECT 00220917
C***** NUMBER (ONE MORE THAN THE RECORD NUMBER LAST READ OR WRITTEN).00230917
C***** THIS TEST WILL BE PERFORMED IN THE SEGMENTS WHICH TEST 00240917
C***** DIRECT ACCESS FILES - SEGMENT DIRAF3 (412). 00250917
C***********************************************************************00260917
C***** 00270917
CBB** ********************** BBCCOMNT **********************************00280917
C**** 00290917
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00300917
C**** VERSION 2.1 00310917
C**** 00320917
C**** 00330917
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00340917
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00350917
C**** SOFTWARE STANDARDS VALIDATION GROUP 00360917
C**** BUILDING 225 RM A266 00370917
C**** GAITHERSBURG, MD 20899 00380917
C**** 00390917
C**** 00400917
C**** 00410917
CBE** ********************** BBCCOMNT **********************************00420917
C***** 00430917
LOGICAL AVB, BVB 00440917
CHARACTER*10 B10VK, D10VK, E11VK*11, G10VK 00450917
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00460917
CBB** ********************** BBCINITA **********************************00470917
C**** SPECIFICATION STATEMENTS 00480917
C**** 00490917
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00500917
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00510917
CBE** ********************** BBCINITA **********************************00520917
CBB** ********************** BBCINITB **********************************00530917
C**** INITIALIZE SECTION 00540917
DATA ZVERS, ZVERSD, ZDATE 00550917
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00560917
DATA ZCOMPL, ZNAME, ZTAPE 00570917
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00580917
DATA ZPROJ, ZTAPED, ZPROG 00590917
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00600917
DATA REMRKS /' '/ 00610917
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00620917
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00630917
C**** 00640917
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00650917
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00660917
CZ03 ZPROG = 'PROGRAM NAME' 00670917
CZ04 ZDATE = 'DATE OF TEST' 00680917
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00690917
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00700917
CZ07 ZNAME = 'NAME OF USER' 00710917
CZ08 ZTAPE = 'TAPE OWNER/ID' 00720917
CZ09 ZTAPED = 'DATE TAPE COPIED' 00730917
C 00740917
IVPASS = 0 00750917
IVFAIL = 0 00760917
IVDELE = 0 00770917
IVINSP = 0 00780917
IVTOTL = 0 00790917
IVTOTN = 0 00800917
ICZERO = 0 00810917
C 00820917
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00830917
I01 = 05 00840917
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00850917
I02 = 06 00860917
C 00870917
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00880917
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00890917
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00900917
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00910917
C 00920917
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00930917
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00940917
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00950917
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00960917
C 00970917
CBE** ********************** BBCINITB **********************************00980917
C***** 00990917
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 01000917
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 01010917
C***** DIRECT, UNFORMATTED FILE. 01020917
C***** 01030917
C I12 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE. 01040917
I12 = 931 01050917
CX120 REPLACED BY FEXEC X-120 CONTROL CARD (DIR. FILE UNIT NUMBER). 01060917
C SPECIFYING I12 = NN OVERRIDES THE DEFAULT I12 = 14. 01070917
C***** 01080917
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01090917
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 01100917
C***** UNFORMATTED FILE. 01110917
C***** 01120917
C***** 01130917
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS 01140917
C***** NOT A VALID RECORD LENGTH. 01150917
MVI = 40 01160917
C***** 01170917
NUVI = I02 01180917
IOVI = I12 01190917
ZPROG = 'FM917' 01200917
IVTOTL = 3 01210917
CBB** ********************** BBCHED0A **********************************01220917
C**** 01230917
C**** WRITE REPORT TITLE 01240917
C**** 01250917
WRITE (I02, 90002) 01260917
WRITE (I02, 90006) 01270917
WRITE (I02, 90007) 01280917
WRITE (I02, 90008) ZVERS, ZVERSD 01290917
WRITE (I02, 90009) ZPROG, ZPROG 01300917
WRITE (I02, 90010) ZDATE, ZCOMPL 01310917
CBE** ********************** BBCHED0A **********************************01320917
C***** 01330917
WRITE(NUVI,43300) 01340917
43300 FORMAT(" ", / " INQU4 - (433) INQUIRE BY UNIT" // 01350917
1 " DIRECT ACCESS UNFORMATTED FILE" // 01360917
2 " ANS REF. - 12.10.3" ) 01370917
CBB** ********************** BBCHED0B **********************************01380917
C**** WRITE DETAIL REPORT HEADERS 01390917
C**** 01400917
WRITE (I02,90004) 01410917
WRITE (I02,90004) 01420917
WRITE (I02,90013) 01430917
WRITE (I02,90014) 01440917
WRITE (I02,90015) IVTOTL 01450917
CBE** ********************** BBCHED0B **********************************01460917
C***** 01470917
C***** OPEN FILE 01480917
OPEN(UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, FORM='UNFORMATTED') 01490917
C***** 01500917
CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN) 01510917
IVTNUM = 1 01520917
INQUIRE(UNIT=IOVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01530917
1 ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 01540917
2 FORM=E11VK, UNFORMATTED=G10VK, ERR=20014,IOSTAT=IVI) 01550917
C***** 01560917
IF (IVI .NE. 0) GO TO 20010 01570917
IF (.NOT. AVB) GO TO 20010 01580917
IF (.NOT. BVB) GO TO 20010 01590917
IF (JVI .NE. IOVI) GO TO 20010 01600917
IF (B10VK .NE. 'DIRECT') GO TO 20010 01610917
IF (D10VK .NE. 'YES') GO TO 20010 01620917
IF (KVI .NE. MVI) GO TO 20010 01630917
IF (LVI .NE. 1) GO TO 20010 01640917
IF (E11VK .NE. 'UNFORMATTED') GO TO 20010 01650917
IF (G10VK .NE. 'YES' ) GO TO 20010 01660917
WRITE (NUVI, 80002) IVTNUM 01670917
IVPASS = IVPASS + 1 01680917
GO TO 0011 01690917
20014 CONTINUE 01700917
WRITE (NUVI, 20015) IVTNUM 01710917
20015 FORMAT (" ",2X,I3,4X," FAIL",12X, 01720917
1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01730917
GO TO 20016 01740917
20010 CONTINUE 01750917
WRITE (NUVI, 20011) IVTNUM 01760917
20011 FORMAT(" ",2X,I3,4X," FAIL",12X, 01770917
1 "ERROR IN AN INQUIRE SPECIFIER" /) 01780917
20016 IVFAIL = IVFAIL + 1 01790917
WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,D10VK, 01800917
1 KVI,LVI,E11VK,G10VK 01810917
20012 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 01820917
1 " ,OPENED=",L1,", NUMBER=",I4,","/ 01830917
2 " ",26X,"ACCESS=",A10,", DIRECT=",A3,", RECL=", 01840917
3 I4,","/" ",26X,"NEXTREC=",I4,", FORM=", 01850917
4 A11,","/" ",26X,"UNFORMATTED=" ,A3) 01860917
WRITE (NUVI, 20013) IOVI, MVI 01870917
20013 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 01880917
1 "OPENED=T, NUMBER=" ,I4,","/ 01890917
2 " ",26X,"ACCESS=DIRECT, DIRECT=YES, RECL=" , 01900917
3 I4,","/" ",26X,"NEXTREC=1, FORM=UNFORMATTED," / 01910917
4 " ",26X,"UNFORMATTED=YES" ) 01920917
0011 CONTINUE 01930917
C***** 01940917
C***** WRITE A RECORD TO FILE 01950917
WRITE(IOVI, REC=1) JVI 01960917
C***** 01970917
CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE) 01980917
IVTNUM = 2 01990917
C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC 02000917
C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED 02010917
INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 02020917
1 ERR=20024, IOSTAT=IVI) 02030917
C***** 02040917
IF (IVI .NE. 0) GO TO 20020 02050917
IF (D10VK .NE. 'YES') GO TO 20020 02060917
IF (KVI .NE. MVI) GO TO 20020 02070917
IF (LVI .NE. 2) GO TO 20020 02080917
WRITE (NUVI, 80002) IVTNUM 02090917
IVPASS = IVPASS + 1 02100917
GO TO 0021 02110917
20024 CONTINUE 02120917
WRITE (NUVI, 20025) IVTNUM 02130917
20025 FORMAT (" ",2X,I3,4X," FAIL",12X, 02140917
1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02150917
GO TO 20026 02160917
20020 CONTINUE 02170917
WRITE (NUVI, 20021) IVTNUM 02180917
20021 FORMAT(" ",2X,I3,4X," FAIL",12X, 02190917
1 "ERROR IN AN INQUIRE SPECIFIER" /) 02200917
20026 IVFAIL = IVFAIL + 1 02210917
WRITE (NUVI, 20022) IVI,D10VK,KVI,LVI 02220917
20022 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", DIRECT=",A3, 02230917
1 " ,RECL=",I4,", NEXTREC=" ,I4) 02240917
WRITE (NUVI, 20023) MVI 02250917
20023 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, DIRECT=YES, " , 02260917
1 "RECL=",I4,", NEXTREC= 2" ) 02270917
0021 CONTINUE 02280917
C***** 02290917
C***** READ A RECORD FROM FILE 02300917
C***** 02310917
READ(IOVI, REC=1) JVI 02320917
C***** 02330917
CT003* TEST 3 - THIRD INQUIRE (AFTER READ) 02340917
IVTNUM = 3 02350917
C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC 02360917
C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED 02370917
INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 02380917
1 ERR=20034, IOSTAT=IVI) 02390917
C***** 02400917
IF (IVI .NE. 0) GO TO 20030 02410917
IF (D10VK .NE. 'YES') GO TO 20030 02420917
IF (KVI .NE. MVI) GO TO 20030 02430917
IF (LVI .NE. 2) GO TO 20030 02440917
WRITE (NUVI, 80002) IVTNUM 02450917
IVPASS = IVPASS + 1 02460917
GO TO 0031 02470917
20034 CONTINUE 02480917
WRITE (NUVI, 20035) IVTNUM 02490917
20035 FORMAT (" ",2X,I3,4X," FAIL",12X, 02500917
1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02510917
GO TO 20036 02520917
20030 CONTINUE 02530917
WRITE (NUVI, 20031) IVTNUM 02540917
20031 FORMAT(" ",2X,I3,4X," FAIL",12X, 02550917
1 "ERROR IN AN INQUIRE SPECIFIER" /) 02560917
20036 IVFAIL = IVFAIL + 1 02570917
WRITE (NUVI, 20032) IVI,D10VK,KVI,LVI 02580917
20032 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", DIRECT=",A3, 02590917
1 " ,RECL=",I4,", NEXTREC=" ,I4) 02600917
WRITE (NUVI, 20023) MVI 02610917
20033 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, DIRECT=YES, " , 02620917
1 "RECL=",I4,", NEXTREC= 2" ) 02630917
0031 CONTINUE 02640917
C***** 02650917
CLOSE(UNIT=IOVI, STATUS='DELETE') 02660917
C***** 02670917
CBB** ********************** BBCSUM0 **********************************02680917
C**** WRITE OUT TEST SUMMARY 02690917
C**** 02700917
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02710917
WRITE (I02, 90004) 02720917
WRITE (I02, 90014) 02730917
WRITE (I02, 90004) 02740917
WRITE (I02, 90020) IVPASS 02750917
WRITE (I02, 90022) IVFAIL 02760917
WRITE (I02, 90024) IVDELE 02770917
WRITE (I02, 90026) IVINSP 02780917
WRITE (I02, 90028) IVTOTN, IVTOTL 02790917
CBE** ********************** BBCSUM0 **********************************02800917
CBB** ********************** BBCFOOT0 **********************************02810917
C**** WRITE OUT REPORT FOOTINGS 02820917
C**** 02830917
WRITE (I02,90016) ZPROG, ZPROG 02840917
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02850917
WRITE (I02,90019) 02860917
CBE** ********************** BBCFOOT0 **********************************02870917
CBB** ********************** BBCFMT0A **********************************02880917
C**** FORMATS FOR TEST DETAIL LINES 02890917
C**** 02900917
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02910917
80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02920917
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02930917
80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02940917
80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02950917
1I6,/," ",15X,"CORRECT= " ,I6) 02960917
80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02970917
1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02980917
80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02990917
1A21,/," ",16X,"CORRECT= " ,A21) 03000917
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03010917
80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03020917
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03030917
80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03040917
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03050917
80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03060917
80050 FORMAT (" ",48X,A31) 03070917
CBE** ********************** BBCFMT0A **********************************03080917
CBB** ********************** BBCFMT0B **********************************03090917
C**** FORMAT STATEMENTS FOR PAGE HEADERS 03100917
C**** 03110917
90002 FORMAT ("1") 03120917
90004 FORMAT (" ") 03130917
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03140917
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03150917
90008 FORMAT (" ",21X,A13,A17) 03160917
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03170917
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03180917
90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03190917
1 7X,"REMARKS",24X) 03200917
90014 FORMAT (" ","----------------------------------------------" , 03210917
1 "---------------------------------" ) 03220917
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03230917
C**** 03240917
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03250917
C**** 03260917
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03270917
90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03280917
1 A13) 03290917
90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03300917
C**** 03310917
C**** FORMAT STATEMENTS FOR RUN SUMMARY 03320917
C**** 03330917
90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03340917
90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03350917
90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03360917
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03370917
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03380917
CBE** ********************** BBCFMT0B **********************************03390917
C***** 03400917
C***** END OF TEST SEGMENT 433 03410917
STOP 03420917
END 03430917