gcc/testsuite/gfortran.dg/unf_io_convert_1.f90

   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
   8 program 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         STOP 1
  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         STOP 2
  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         STOP 3
  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            STOP 4
  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         STOP 5
  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
  95 end program main