gcc/testsuite/gfortran.dg/unformatted_subrecord_1.f90

   1 ! { dg-do run { target fd_truncate } }
   2 ! { dg-options "-fmax-subrecord-length=16" }
   3 ! Test Intel record markers with 16-byte subrecord sizes.
   4 ! PR 32770:  Use explicit kinds for all integers and constants,
   5 ! to avoid problems with -fdefault-integer-8 and -fdefault-real-8
   6 program main
   7   implicit none
   8   integer(kind=4), dimension(20) :: n
   9   integer(kind=4), dimension(30) :: m
  10   integer(kind=4) :: i
  11   real(kind=4) :: r
  12   integer(kind=4) :: k
  13   ! Maximum subrecord length is 16 here, or the test will fail.
  14   open (10, file="f10.dat", &
  15        form="unformatted", access="sequential")
  16   n = (/ (i**2, i=1, 20) /)
  17   write (10) n
  18   close (10)
  19   ! Read back the file, including record markers.
  20   open (10, file="f10.dat", form="unformatted", access="stream")
  21   read (10) m
  22   if (any(m .ne. (/ -16, 1, 4, 9, 16, 16, -16, 25, 36, 49, 64, &
  23        -16, -16, 81, 100, 121, 144, -16, -16, 169, 196, 225, &
  24        256, -16, 16, 289, 324, 361, 400, -16 /))) call abort
  25   close (10)
  26   open (10, file="f10.dat", form="unformatted", &
  27        access="sequential")
  28   m = 42
  29   read (10) m(1:5)
  30   if (any(m(1:5) .ne. (/ 1, 4, 9, 16, 25 /))) call abort
  31   if (any(m(6:30) .ne. 42)) call abort
  32   backspace 10
  33   n = 0
  34   read (10) n(1:5)
  35   if (any(n(1:5) .ne. (/ 1, 4, 9, 16, 25 /))) call abort
  36   if (any(n(6:20) .ne. 0)) call abort
  37   ! Append to the end of the file
  38   write (10) 3.14_4
  39   ! Test multiple backspace statements
  40   backspace 10
  41   backspace 10
  42   read (10) k
  43   if (k .ne. 1) call abort
  44   read (10) r
  45   if (abs(r-3.14_4) .gt. 1e-7) call abort
  46   close (10, status="delete")
  47 end program main