Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/char_result_15.f90 @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | 04ced10e8804 |
children |
line wrap: on
line source
! { dg-do run } ! ! Tests the fix for PR44265. This test arose because of an issue found ! during the development of the fix; namely the clash between the normal ! module parameter and that found in the specification expression for ! 'Get'. ! ! Contributed by Paul Thomas <pault@gcc.gnu.org> ! MODULE Fruits IMPLICIT NONE PRIVATE character (20) :: buffer PUBLIC :: Get, names, fruity, buffer CHARACTER(len=7), PARAMETER :: names(3) = [ & 'Pomme ', & 'Orange ', & 'Mangue ' ]; CONTAINS FUNCTION Get(i) RESULT(s) CHARACTER(len=7), PARAMETER :: names(3) = [ & 'Apple ', & 'Orange ', & 'Mango ' ]; INTEGER, INTENT(IN) :: i CHARACTER(LEN_TRIM(names(i))) :: s s = names(i) END FUNCTION Get subroutine fruity (i) integer :: i write (buffer, '(i2,a)') len (Get (i)), Get (i) end subroutine END MODULE Fruits PROGRAM WheresThatbLinkingConstantGone USE Fruits IMPLICIT NONE integer :: i write (buffer, '(i2,a)') len (Get (1)), Get (1) if (trim (buffer) .ne. " 5Apple") STOP 1 call fruity(3) if (trim (buffer) .ne. " 5Mango") STOP 2 if (trim (names(3)) .ne. "Mangue") STOP 3 END PROGRAM WheresThatbLinkingConstantGone