gcc/testsuite/gfortran.dg/fmt_cache_1.f

   1 ! { dg-do run { target fd_truncate } }
   2 ! pr40662 segfaults when specific format is invoked twice.
   3 ! pr40330  incorrect io.
   4 ! test case derived from pr40662, <jvdelisle@gcc.gnu.org>
   5       program astap
   6       implicit none
   7       character(34) :: teststring
   8       real(4) :: arlxca = 0.0
   9       open(10)
  10       write(10,40) arlxca
  11       write(10,40) arlxca
  12 40    format(t4,"arlxca = ",1pg13.6,t27,"arlxcc = ",g13.6,t53,
  13      .            "atmpca = ",g13.6,t79,"atmpcc = ",g13.6,t105,
  14      .            "backup = ",g13.6,/,
  15      .         t4,"csgfac = ",g13.6,t27,"csgmax = ",g13.6,t53,
  16      .            "csgmin = ",g13.6,t79,"drlxca = ",g13.6,t105,
  17      .            "drlxcc = ",g13.6,/,
  18      .         t4,"dtimeh = ",g13.6,t27,"dtimei = ",g13.6,t53,
  19      .            "dtimel = ",g13.6,t79,"dtimeu = ",g13.6,t105,
  20      .            "dtmpca = ",g13.6,/,
  21      .         t4,"dtmpcc = ",g13.6,t27,"ebalna = ",g13.6,t53,
  22      .            "ebalnc = ",g13.6,t79,"ebalsa = ",g13.6,t105,
  23      .            "ebalsc = ",g13.6)
  24       rewind 10
  25       teststring = ""
  26       read(10,'(a)') teststring
  27       if (teststring.ne."   arlxca =   0.00000     arlxcc =")call abort
  28       teststring = ""
  29       read(10,'(a)') teststring
  30       if (teststring.ne."   arlxca =   0.00000     arlxcc =")call abort
  31       close(10, status='delete')
  32       end program astap
  33
  34