URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [gfortran.dg/] [direct_io_2.f90] - Blame information for rev 12

Details | Compare with Previous | View Log


! { dg-do run }
!
! 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)
      OPEN (7, ACCESS = 'DIRECT', RECL = 80, STATUS='REPLACE' )
      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

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

Browse

Tools

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [gfortran.dg/] [direct_io_2.f90] - Blame information for rev 12