! { 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 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