1! { dg-do run }
2! { dg-options "-pedantic" }
3!  This test verifies the most basic sequential unformatted I/O
4!  with convert="swap".
5!  Adapted from seq_io.f.
6!      write 3 records of various sizes
7!      then read them back
8program main
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 r(size)
18  integer i
19  character(4) str
20
21  m(1) = Z'11223344' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
22  m(2) = Z'55667788' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
23  n    = Z'77AABBCC' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
24  str = 'asdf'
25  do i = 1,size
26     r(i) = i
27  end do
28  open(9,form="unformatted",access="sequential",convert="swap") ! { dg-warning "Extension: CONVERT" }
29  write(9) m  ! an array of 2
30  write(9) n  ! an integer
31  write(9) r  ! an array of reals
32  write(9)str ! String
33! zero all the results so we can compare after they are read back
34  do i = 1,size
35     r(i) = 0
36  end do
37  m(1) = 0
38  m(2) = 0
39  n = 0
40  str = ' '
41
42  rewind(9)
43  read(9) m
44  read(9) n
45  read(9) r
46  read(9) str
47  !
48  ! check results
49  if (m(1).ne.Z'11223344') then
50     if (debug) then
51        print '(A,Z8)','m(1) incorrect.  m(1) = ',m(1)
52     else
53        call abort
54     endif
55  endif
56
57  if (m(2).ne.Z'55667788') then
58     if (debug) then
59        print '(A,Z8)','m(2) incorrect.  m(2) = ',m(2)
60     else
61        call abort
62     endif
63  endif
64
65  if (n.ne.Z'77AABBCC') then
66     if (debug) then
67        print '(A,Z8)','n incorrect.  n = ',n
68     else
69        call abort
70     endif
71  endif
72
73  do i = 1,size
74     if (int(r(i)).ne.i) then
75        if (debug) then
76           print*,'element ',i,' was ',r(i),' should be ',i
77        else
78           call abort
79        endif
80     endif
81  end do
82  if (str .ne. 'asdf') then
83     if (debug) then
84        print *,'str incorrect, str = ', str
85     else
86        call abort
87     endif
88  end if
89  ! use hexdump to look at the file "fort.9"
90  if (debug) then
91     close(9)
92  else
93     close(9,status='DELETE')
94  endif
95end program main
96