(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
char_result_14.f90
! { dg-do run }
!
! Tests the fix for PR44265. This is the original test with the addition
! of the check of the issue found in comment #1 of the PR.
!
! Contributed by Ian Harvey  <ian_harvey@bigpond.com>
! Ian also contributed the first version of the fix.
!
! The original version of the bug
MODULE Fruits0
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: Get0
CONTAINS
  FUNCTION Get0(i) RESULT(s)
    CHARACTER(*), PARAMETER :: names(3) = [  &
        'Apple  ',  &
        'Orange ',  &
        'Mango  ' ];
    INTEGER, INTENT(IN) :: i
    CHARACTER(LEN_TRIM(names(i))) :: s
    !****
    s = names(i)
  END FUNCTION Get0
END MODULE Fruits0
!
! Version that came about from sorting other issues.
MODULE Fruits
  IMPLICIT NONE
  PRIVATE
    character (20) :: buffer
    CHARACTER(*), PARAMETER :: names(4) = [  &
        'Apple  ',  &
        'Orange ',  &
        'Mango  ',  &
        'Pear   ' ];
  PUBLIC :: Get, SGet, fruity2, fruity3, buffer
CONTAINS
! This worked previously
  subroutine fruity3
    write (buffer, '(i2,a)') len (Get (4)), Get (4)
  end
! Original function in the PR
  FUNCTION Get(i) RESULT(s)
    INTEGER, INTENT(IN) :: i
    CHARACTER(LEN_trim(names(i))) :: s
    !****
    s = names(i)
  END FUNCTION Get
! Check that dummy is OK
  Subroutine Sget(i, s)
    CHARACTER(*), PARAMETER :: names(4) = [  &
        'Apple  ',  &
        'Orange ',  &
        'Mango  ',  &
        'Pear   ' ];
    INTEGER, INTENT(IN) :: i
    CHARACTER(LEN_trim(names(i))), intent(out) :: s
    !****
    s = names(i)
    write (buffer, '(i2,a)') len (s), s
  END subroutine SGet
! This would fail with undefined references to mangled 'names' during linking
  subroutine fruity2
    write (buffer, '(i2,a)') len (Get (3)), Get (3)
  end
END MODULE Fruits

PROGRAM WheresThatbLinkingConstantGone
  use Fruits0
  USE Fruits
  IMPLICIT NONE
  character(7) :: arg = ""
  integer :: i

! Test the fix for the original bug
  if (len (Get0(1)) .ne. 5) STOP 1
  if (Get0(2) .ne. "Orange") STOP 2

! Test the fix for the subsequent issues
  call fruity
  if (trim (buffer) .ne. " 6Orange") STOP 3
  call fruity2
  if (trim (buffer) .ne. " 5Mango") STOP 4
  call fruity3
  if (trim (buffer) .ne. " 4Pear") STOP 5
  do i = 3, 4
    call Sget (i, arg)
    if (i == 3) then
      if (trim (buffer) .ne. " 5Mango") STOP 6
      if (trim (arg) .ne. "Mango") STOP 7
    else
      if (trim (buffer) .ne. " 4Pear") STOP 8
! Since arg is fixed length in this scope, it gets over-written
! by s, which in this case is length 4. Thus, the 'o' remains.
      if (trim (arg) .ne. "Pearo") STOP 9
    end if
  enddo
contains
  subroutine fruity
      write (buffer, '(i2,a)') len (Get (2)), Get (2)
  end
END PROGRAM WheresThatbLinkingConstantGone