gcc/testsuite/gfortran.dg/string_length_1.f90

   1 ! { dg-do run }
   2 ! Testcase for PR 31203
   3 ! We used to create strings with negative length
   4 subroutine foo(i)
   5   integer :: i
   6   character(len=i) :: s(2)
   7   if (len(s) < 0) call abort
   8   if (len(s) /= max(i,0)) call abort
   9 end
  10
  11 function gee(i)
  12   integer, intent(in) :: i
  13   character(len=i) :: gee
  14
  15   gee = ""
  16 end function gee
  17
  18 subroutine s1(i,j)
  19   character(len=i-j) :: a
  20   if (len(a) < 0) call abort()
  21 end subroutine
  22
  23 program test
  24   interface
  25     function gee(i)
  26       integer, intent(in) :: i
  27       character(len=i) :: gee
  28     end function gee
  29   end interface
  30
  31   call foo(2)
  32   call foo(-1)
  33   call s1(1,2)
  34   call s1(-1,-8)
  35   call s1(-8,-1)
  36
  37   if (len(gee(2)) /= 2) call abort
  38   if (len(gee(-5)) /= 0) call abort
  39   if (len(gee(intfunc(3))) /= max(intfunc(3),0)) call abort
  40   if (len(gee(intfunc(2))) /= max(intfunc(2),0)) call abort
  41
  42   if (len(bar(2)) /= 2) call abort
  43   if (len(bar(-5)) /= 0) call abort
  44   if (len(bar(intfunc(3))) /= max(intfunc(3),0)) call abort
  45   if (len(bar(intfunc(2))) /= max(intfunc(2),0)) call abort
  46
  47   if (cow(bar(2)) /= 2) call abort
  48   if (cow(bar(-5)) /= 0) call abort
  49   if (cow(bar(intfunc(3))) /= max(intfunc(3),0)) call abort
  50   if (cow(bar(intfunc(2))) /= max(intfunc(2),0)) call abort
  51
  52 contains
  53
  54   function bar(i)
  55     integer, intent(in) :: i
  56     character(len=i) :: bar
  57
  58     bar = ""
  59   end function bar
  60
  61   function cow(c)
  62     character(len=*), intent(in) :: c
  63     integer :: cow
  64     cow = len(c)
  65   end function cow
  66
  67   pure function intfunc(i)
  68     integer, intent(in) :: i
  69     integer :: intfunc
  70
  71     intfunc = 2*i-5
  72   end function intfunc
  73
  74 end program test