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