gcc/testsuite/gfortran.dg/char_result_14.f90

   1 ! { dg-do run }
   2 !
   3 ! Tests the fix for PR44265. This is the original test with the addition
   4 ! of the check of the issue found in comment #1 of the PR.
   5 !
   6 ! Contributed by Ian Harvey  <ian_harvey@bigpond.com>
   7 ! Ian also contributed the first version of the fix.
   8 !
   9 ! The original version of the bug
  10 MODULE Fruits0
  11   IMPLICIT NONE
  12   PRIVATE
  13   PUBLIC :: Get0
  14 CONTAINS
  15   FUNCTION Get0(i) RESULT(s)
  16     CHARACTER(*), PARAMETER :: names(3) = [  &
  17         'Apple  ',  &
  18         'Orange ',  &
  19         'Mango  ' ];
  20     INTEGER, INTENT(IN) :: i
  21     CHARACTER(LEN_TRIM(names(i))) :: s
  22     !****
  23     s = names(i)
  24   END FUNCTION Get0
  25 END MODULE Fruits0
  26 !
  27 ! Version that came about from sorting other issues.
  28 MODULE Fruits
  29   IMPLICIT NONE
  30   PRIVATE
  31     character (20) :: buffer
  32     CHARACTER(*), PARAMETER :: names(4) = [  &
  33         'Apple  ',  &
  34         'Orange ',  &
  35         'Mango  ',  &
  36         'Pear   ' ];
  37   PUBLIC :: Get, SGet, fruity2, fruity3, buffer
  38 CONTAINS
  39 ! This worked previously
  40   subroutine fruity3
  41     write (buffer, '(i2,a)') len (Get (4)), Get (4)
  42   end
  43 ! Original function in the PR
  44   FUNCTION Get(i) RESULT(s)
  45     INTEGER, INTENT(IN) :: i
  46     CHARACTER(LEN_trim(names(i))) :: s
  47     !****
  48     s = names(i)
  49   END FUNCTION Get
  50 ! Check that dummy is OK
  51   Subroutine Sget(i, s)
  52     CHARACTER(*), PARAMETER :: names(4) = [  &
  53         'Apple  ',  &
  54         'Orange ',  &
  55         'Mango  ',  &
  56         'Pear   ' ];
  57     INTEGER, INTENT(IN) :: i
  58     CHARACTER(LEN_trim(names(i))), intent(out) :: s
  59     !****
  60     s = names(i)
  61     write (buffer, '(i2,a)') len (s), s
  62   END subroutine SGet
  63 ! This would fail with undefined references to mangled 'names' during linking
  64   subroutine fruity2
  65     write (buffer, '(i2,a)') len (Get (3)), Get (3)
  66   end
  67 END MODULE Fruits
  68
  69 PROGRAM WheresThatbLinkingConstantGone
  70   use Fruits0
  71   USE Fruits
  72   IMPLICIT NONE
  73   character(7) :: arg = ""
  74   integer :: i
  75
  76 ! Test the fix for the original bug
  77   if (len (Get0(1)) .ne. 5) STOP 1
  78   if (Get0(2) .ne. "Orange") STOP 2
  79
  80 ! Test the fix for the subsequent issues
  81   call fruity
  82   if (trim (buffer) .ne. " 6Orange") STOP 3
  83   call fruity2
  84   if (trim (buffer) .ne. " 5Mango") STOP 4
  85   call fruity3
  86   if (trim (buffer) .ne. " 4Pear") STOP 5
  87   do i = 3, 4
  88     call Sget (i, arg)
  89     if (i == 3) then
  90       if (trim (buffer) .ne. " 5Mango") STOP 6
  91       if (trim (arg) .ne. "Mango") STOP 7
  92     else
  93       if (trim (buffer) .ne. " 4Pear") STOP 8
  94 ! Since arg is fixed length in this scope, it gets over-written
  95 ! by s, which in this case is length 4. Thus, the 'o' remains.
  96       if (trim (arg) .ne. "Pearo") STOP 9
  97     end if
  98   enddo
  99 contains
 100   subroutine fruity
 101       write (buffer, '(i2,a)') len (Get (2)), Get (2)
 102   end
 103 END PROGRAM WheresThatbLinkingConstantGone