gcc/testsuite/gfortran.dg/pr114304.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/114304
   4 !
   5 ! See also PR fortran/105473
   6 !
   7 ! Testing: Does list-directed reading an integer/real allow some non-integer input?
   8 !
   9 ! Note: GCC result comments before fix of this PR.
  10
  11   implicit none
  12   call t(.true.,  'comma', ';') ! No error shown
  13   call t(.false., 'point', ';') ! /!\ gfortran: no error, others: error
  14   call t(.false., 'comma', ',') ! Error shown
  15   call t(.true.,  'point', ',') ! No error shown
  16   call t(.false., 'comma', '.') ! Error shown
  17   call t(.false., 'point', '.') ! Error shown
  18   call t(.false., 'comma', '5.') ! Error shown
  19   call t(.false., 'point', '5.') ! gfortran/flang: Error shown, ifort: no error
  20   call t(.false., 'comma', '5,') ! gfortran: error; others: no error
  21   call t(.true.,  'point', '5,') ! No error shown
  22   call t(.true.,  'comma', '5;') ! No error shown
  23   call t(.false., 'point', '5;') ! /!\ gfortran: no error shown, others: error
  24   call t(.true.,  'comma', '7 .') ! No error shown
  25   call t(.true.,  'point', '7 .') ! No error shown
  26   call t(.true.,  'comma', '7 ,') ! /!\ gfortran: error; others: no error
  27   call t(.true.,  'point', '7 ,') ! No error shown
  28   call t(.true.,  'comma', '7 ;') ! No error shown
  29   call t(.true.,  'point', '7 ;') ! No error shown
  30
  31 !  print *, '---------------'
  32
  33   call t(.false., 'comma', '8.', .true.) ! Error shown
  34   call t(.true.,  'point', '8.', .true.) ! gfortran/flang: Error shown, ifort: no error
  35   call t(.true.,  'comma', '8,', .true.) ! gfortran: error; others: no error
  36   call t(.true.,  'point', '8,', .true.) ! No error shown
  37   call t(.true.,  'comma', '8;', .true.) ! No error shown
  38   call t(.false., 'point', '8;', .true.) ! /!\ gfortran: no error shown, others: error
  39   call t(.true.,  'comma', '9 .', .true.) ! No error shown
  40   call t(.true.,  'point', '9 .', .true.) ! No error shown
  41   call t(.true.,  'comma', '9 ,', .true.) ! /!\ gfortran: error; others: no error
  42   call t(.true.,  'point', '9 ,', .true.) ! No error shown
  43   call t(.true.,  'comma', '9 ;', .true.) ! No error shown
  44   call t(.true.,  'point', '9 ;', .true.) ! No error shown
  45   call t(.false., 'comma', '3,3.', .true.) ! Error shown
  46   call t(.false., 'point', '3.3.', .true.) ! Error shown
  47   call t(.false., 'comma', '3,3,', .true.) ! gfortran/flang: no error; ifort: error
  48   call t(.true.,  'comma', '3,3;', .true.) ! No error shown
  49   call t(.false., 'point', '3.3;', .true.) ! gfortran/flang: no error; ifort: error
  50   call t(.true.,  'comma', '4,4 .', .true.) ! N error shown
  51   call t(.true.,  'point', '4.4 .', .true.) ! No error shown
  52   call t(.true.,  'comma', '4,4 ,', .true.) ! /!\ gfortran: error; others: no error
  53   call t(.true.,  'point', '4.4 ,', .true.) ! No error shown
  54   call t(.true.,  'comma', '4,4 ;', .true.) ! No error shown
  55   call t(.true.,  'point', '4.4 ;', .true.) ! No error shown
  56
  57 !  print *, '---------------'
  58
  59   call t(.true.,  'comma', '8', .true.)
  60   call t(.true.,  'point', '8', .true.)
  61   call t(.true.,  'point', '9 ;', .true.)
  62   call t(.true.,  'comma', '3;3.', .true.)
  63   call t(.true.,  'point', '3,3.', .true.)
  64   call t(.true.,  'comma', '3;3,', .true.)
  65   call t(.true.,  'comma', '3;3;', .true.)
  66   call t(.true.,  'point', '3,3;', .true.)
  67   call t(.true.,  'comma', '4;4 .', .true.)
  68   call t(.true.,  'point', '4,4 .', .true.)
  69   call t(.true.,  'comma', '4;4 ,', .true.)
  70   call t(.true.,  'point', '4,4 ,', .true.)
  71   call t(.true.,  'comma', '4;4 ;', .true.)
  72   call t(.true.,  'point', '4,4 ;', .true.)
  73
  74   call t2('comma', ',2')
  75   call t2('point', '.2')
  76   call t2('comma', ',2;')
  77   call t2('point', '.2,')
  78   call t2('comma', ',2 ,')
  79   call t2('point', '.2 .')
  80 contains
  81 subroutine t2(dec, testinput)
  82   character(*) :: dec, testinput
  83   integer ios
  84   real :: r
  85   r = 42
  86   read(testinput,*,decimal=dec, iostat=ios) r
  87   if (ios /= 0 .or.  abs(r - 0.2) > epsilon(r)) then
  88     stop 3
  89   end if
  90 end
  91 subroutine t(valid, dec, testinput, isreal)
  92   logical, value :: valid
  93   character(len=*) :: dec, testinput
  94   logical, optional :: isreal
  95   logical :: isreal2
  96   integer n,ios
  97   real :: r
  98   r = 42; n = 42
  99   isreal2 = .false.
 100   if (present(isreal)) isreal2 = isreal
 101
 102   if (isreal2) then
 103     read(testinput,*,decimal=dec,iostat=ios) r
 104     if ((valid .and. ios /= 0) .or. (.not.valid .and. ios == 0)) then
 105       stop 1
 106     end if
 107   else
 108     read(testinput,*,decimal=dec,iostat=ios) n
 109     if ((valid .and. ios /= 0) .or. (.not.valid .and. ios == 0)) then
 110       stop 1
 111     end if
 112   end if
 113 end
 114 end program