gcc/testsuite/gfortran.dg/fgetc_3.f90

   1 ! Testcase for the FGETC and FPUTC intrinsics
   2 ! { dg-do compile }
   3   character(len=5) s
   4   integer st
   5
   6   s = "12345"
   7   open(status="scratch")
   8   write(*,"(A)") "abcde"
   9   rewind(10)
  10   st = fget(s)
  11   if ((st /= 0) .or. (s /= "a    ")) call abort
  12   st = fget(s)
  13   close(10)
  14
  15   open(status="scratch")
  16   s = "12345"
  17   st = fput(s)
  18   if (st /= 0) call abort
  19   st = fput("2")
  20   if (st /= 0) call abort
  21   st = fput("3 ")
  22   if (st /= 0) call abort
  23   rewind(10)
  24   st = fget(s)
  25   if (s(1:1) /= "1") call abort
  26   st = fget(s)
  27   if (s(1:1) /= "2") call abort
  28   st = fget(s)
  29   if ((s(1:1) /= "3") .or. (st /= 0)) call abort
  30   st = fget(s)
  31   if (st /= -1) call abort
  32   close (10)
  33
  34   end