libgomp/testsuite/libgomp.fortran/async_io_4.f90

   1 ! { dg-do run { target fd_truncate } }
   2 !TODO: Move these testcases to gfortran testsuite
   3 ! once compilation with pthreads is supported there
   4
   5 ! Test BACKSPACE for synchronous and asynchronous I/O
   6 program main
   7
   8   integer i, n, nr
   9   real x(10), y(10)
  10
  11   ! PR libfortran/20068
  12   open (20, status='scratch', asynchronous="yes")
  13   write (20,*, asynchronous="yes" ) 1
  14   write (20,*, asynchronous="yes") 2
  15   write (20,*, asynchronous="yes") 3
  16   rewind (20)
  17   i = 41
  18   read (20,*, asynchronous="yes") i
  19   wait (20)
  20   if (i .ne. 1) STOP 1
  21   write (*,*) ' '
  22   backspace (20)
  23   i = 42
  24   read (20,*, asynchronous="yes") i
  25   close (20)
  26   if (i .ne. 1) STOP 2
  27
  28   ! PR libfortran/20125
  29   open (20, status='scratch', asynchronous="yes")
  30   write (20,*, asynchronous="yes") 7
  31   backspace (20)
  32   read (20,*, asynchronous="yes") i
  33   wait (20)
  34   if (i .ne. 7) STOP 3
  35   close (20)
  36
  37   open (20, status='scratch', form='unformatted')
  38   write (20) 8
  39   backspace (20)
  40   read (20) i
  41   if (i .ne. 8) STOP 4
  42   close (20)
  43
  44   ! PR libfortran/20471
  45   do n = 1, 10
  46      x(n) = sqrt(real(n))
  47   end do
  48   open (3, form='unformatted', status='scratch')
  49   write (3) (x(n),n=1,10)
  50   backspace (3)
  51   rewind (3)
  52   read (3) (y(n),n=1,10)
  53
  54   do n = 1, 10
  55      if (abs(x(n)-y(n)) > 0.00001) STOP 5
  56   end do
  57   close (3)
  58
  59   ! PR libfortran/20156
  60   open (3, form='unformatted', status='scratch')
  61   do i = 1, 5
  62      x(1) = i
  63      write (3) n, (x(n),n=1,10)
  64   end do
  65   nr = 0
  66   rewind (3)
  67 20 continue
  68   read (3,end=30,err=90) n, (x(n),n=1,10)
  69   nr = nr + 1
  70   goto 20
  71 30 continue
  72   if (nr .ne. 5) STOP 6
  73
  74   do i = 1, nr+1
  75      backspace (3)
  76   end do
  77
  78   do i = 1, nr
  79      read(3,end=70,err=90) n, (x(n),n=1,10)
  80      if (abs(x(1) - i) .gt. 0.001) STOP 7
  81   end do
  82   close (3)
  83   stop
  84
  85 70 continue
  86   STOP 8
  87 90 continue
  88   STOP 9
  89
  90 end program