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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [seq_io.f90] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
! pr 15472
2
! sequential access files
3
!
4
!  this test verifies the most basic sequential unformatted I/O
5
!      write 3 records of various sizes
6
!      then read them back
7
!      and compare with what was written
8
!
9
       implicit none
10
       integer size
11
       parameter(size=100)
12
       logical debug
13
       data debug /.FALSE./
14
! set debug to true for help in debugging failures.
15
       integer m(2)
16
       integer n
17
       real*4 r(size)
18
       integer i
19
       m(1) = Z'11111111'
20
       m(2) = Z'22222222'
21
       n    = Z'33333333'
22
       do i = 1,size
23
         r(i) = i
24
       end do
25
       write(9)m  ! an array of 2
26
       write(9)n  ! an integer
27
       write(9)r  ! an array of reals
28
! zero all the results so we can compare after they are read back
29
       do i = 1,size
30
          r(i) = 0
31
       end do
32
       m(1) = 0
33
       m(2) = 0
34
       n = 0
35
 
36
       rewind(9)
37
       read(9)m
38
       read(9)n
39
       read(9)r
40
!
41
! check results
42
       if (m(1).ne.Z'11111111') then
43
         if (debug) then
44
            print '(A,Z8)','m(1) incorrect.  m(1) = ',m(1)
45
         else
46
            call abort
47
         endif
48
       endif
49
 
50
       if (m(2).ne.Z'22222222') then
51
         if (debug) then
52
            print '(A,Z8)','m(2) incorrect.  m(2) = ',m(2)
53
         else
54
            call abort
55
         endif
56
       endif
57
 
58
       if (n.ne.Z'33333333') then
59
         if (debug) then
60
            print '(A,Z8)','n incorrect.  n = ',n
61
         else
62
            call abort
63
         endif
64
       endif
65
 
66
       do i = 1,size
67
          if (int(r(i)).ne.i) then
68
            if (debug) then
69
              print*,'element ',i,' was ',r(i),' should be ',i
70
            else
71
              call abort
72
            endif
73
          endif
74
       end do
75
! use hexdump to look at the file "fort.9"
76
       if (debug) then
77
         close(9)
78
       else
79
         close(9,status='DELETE')
80
       endif
81
       end

powered by: WebSVN 2.1.0

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