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'
  22   m(2) = Z'55667788'
  23   n    = Z'77AABBCC'
  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
  95 end program main