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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [direct_io_2.f90] - Blame information for rev 708

Go to most recent revision | Details | Compare with Previous | View Log


! { 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

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

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [direct_io_2.f90] - Blame information for rev 708