gcc/testsuite/gfortran.dg/list_read_3.f90

   1 ! { dg-do run }
   2 ! Program to test reading in a list of integer values into REAL variables.
   3 ! The comma separator was not handled correctly.
   4 !
   5 program fg
   6
   7   character(len=80) buff
   8   logical debug
   9
  10   debug = .FALSE.
  11   a = 0
  12   b = 0
  13   c = 0
  14   d = 0
  15   write (buff,'(a)') '10,20,30,40'
  16   read(buff,*) a, b, c, d
  17
  18   if (debug) then
  19     print*,buff
  20     print*,a, b, c, d
  21   end if
  22
  23   if (abs(10. - a) > 1e-5) call abort
  24   if (abs(20. - b) > 1e-5) call abort
  25   if (abs(30. - c) > 1e-5) call abort
  26   if (abs(40. - d) > 1e-5) call abort
  27
  28   a = 0
  29   b = 0
  30   c = 0
  31   d = 0
  32   write (buff,'(a)') '10.,20.,30.,40.'
  33   read(buff,*) a, b, c, d
  34
  35   if (abs(10. - a) > 1e-5) call abort
  36   if (abs(20. - b) > 1e-5) call abort
  37   if (abs(30. - c) > 1e-5) call abort
  38   if (abs(40. - d) > 1e-5) call abort
  39
  40   if (debug) then
  41     print*,buff
  42     print*,a, b, c, d
  43   end if
  44
  45   a = 0
  46   b = 0
  47   c = 0
  48   d = 0
  49   write (buff,'(a)') '10.0,20.0,30.0,40.0'
  50   read(buff,*) a, b, c, d
  51
  52   if (abs(10. - a) > 1e-5) call abort
  53   if (abs(20. - b) > 1e-5) call abort
  54   if (abs(30. - c) > 1e-5) call abort
  55   if (abs(40. - d) > 1e-5) call abort
  56
  57   if (debug) then
  58     print*,buff
  59     print*,a, b, c, d
  60   end if
  61
  62
  63   a = 0
  64   b = -99
  65   c = 0
  66   d = 0
  67   write (buff,'(a)') '10.0,,30.0,40.0'
  68   read(buff,*) a, b, c, d
  69
  70   if (abs(10. - a) > 1e-5) call abort
  71   if (abs(-99. - b) > 1e-5) call abort
  72   if (abs(30. - c) > 1e-5) call abort
  73   if (abs(40. - d) > 1e-5) call abort
  74
  75   if (debug) then
  76     print*,buff
  77     print*,a, b, c, d
  78   end if
  79
  80
  81    call abc
  82
  83 end program
  84
  85 subroutine abc
  86
  87   character(len=80) buff
  88
  89   a = 0
  90   b = 0
  91   c = 0
  92   d = 0
  93   write (buff,'(a)') '10,-20,30,-40'
  94   read(buff,*) a, b, c, d
  95
  96   if (abs(10. - a) > 1e-5) call abort
  97   if (abs(-20. - b) > 1e-5) call abort
  98   if (abs(30. - c) > 1e-5) call abort
  99   if (abs(-40. - d) > 1e-5) call abort
 100
 101 end subroutine abc