summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/direct_io_2.f90
blob: 8e18052ff011f12d2d623e7dd1c54f6935cef759 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
! { dg-do run }
! { dg-options "-std=legacy" }
!
! this testcase derived from NIST test FM413.FOR
! tests writing direct access files in ascending and descending
! REC's.
      PROGRAM FM413
      IMPLICIT LOGICAL (L)
      IMPLICIT CHARACTER*14 (C)
      IMPLICIT INTEGER(4) (I)
      DATA IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 /14*0/
      OPEN (7, ACCESS = 'DIRECT', RECL = 80, STATUS='REPLACE', FILE="FOO" )
      IRECN = 13
      IREC = 13
      DO 4132 I = 1,100
      IREC = IREC + 2
      IRECN = IRECN + 2
      WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
 4132 CONTINUE
      IRECN = 216
      IREC = 216
      DO 4133 I=1,100
      IREC = IREC - 2
      IRECN = IRECN - 2
      WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
 4133 CONTINUE
      IRECCK = 13
      IRECN = 0
      IREC = 13
      IVCOMP = 0
      DO 4134 I = 1,100
      IREC = IREC + 2
      IRECCK = IRECCK + 2
      READ(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
      IF (IRECN .NE. IRECCK) CALL ABORT
 4134 CONTINUE
      IRECCK = 216
      IRECN = 0
      IREC = 216
      DO 4135 I = 1,100
      IREC = IREC - 2
      IRECCK = IRECCK - 2
      READ(7, REC = IREC)  IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
      IF (IRECN .NE. IRECCK) CALL ABORT
 4135 CONTINUE
      CLOSE(7, STATUS='DELETE')
      STOP
      END