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