gcc/testsuite/gfortran.dg/string_length_1.f90

! { dg-do run }
! Testcase for PR 31203
! We used to create strings with negative length
subroutine foo(i)
  integer :: i
  character(len=i) :: s(2)
  if (len(s) < 0) STOP 1
  if (len(s) /= max(i,0)) STOP 2
end

function gee(i)
  integer, intent(in) :: i
  character(len=i) :: gee

  gee = ""
end function gee

subroutine s1(i,j)
  character(len=i-j) :: a
  if (len(a) < 0) STOP 1
end subroutine

program test
  interface
    function gee(i)
      integer, intent(in) :: i
      character(len=i) :: gee
    end function gee
  end interface

  call foo(2)
  call foo(-1)
  call s1(1,2)
  call s1(-1,-8)
  call s1(-8,-1)

  if (len(gee(2)) /= 2) STOP 3
  if (len(gee(-5)) /= 0) STOP 4
  if (len(gee(intfunc(3))) /= max(intfunc(3),0)) STOP 5
  if (len(gee(intfunc(2))) /= max(intfunc(2),0)) STOP 6

  if (len(bar(2)) /= 2) STOP 7
  if (len(bar(-5)) /= 0) STOP 8
  if (len(bar(intfunc(3))) /= max(intfunc(3),0)) STOP 9
  if (len(bar(intfunc(2))) /= max(intfunc(2),0)) STOP 10

  if (cow(bar(2)) /= 2) STOP 11
  if (cow(bar(-5)) /= 0) STOP 12
  if (cow(bar(intfunc(3))) /= max(intfunc(3),0)) STOP 13
  if (cow(bar(intfunc(2))) /= max(intfunc(2),0)) STOP 14

contains

  function bar(i)
    integer, intent(in) :: i
    character(len=i) :: bar
  
    bar = ""
  end function bar

  function cow(c)
    character(len=*), intent(in) :: c
    integer :: cow
    cow = len(c)
  end function cow

  pure function intfunc(i)
    integer, intent(in) :: i
    integer :: intfunc

    intfunc = 2*i-5
  end function intfunc

end program test