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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [direct_io_2.f90] - Blame information for rev 841

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

Line No. Rev Author Line
1 149 jeremybenn
! { 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', FILE="FOO" )
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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.