aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/elemental_subroutine_9.f90
blob: 8f574bf595e82d6787239914bc886711a530200a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
! { dg-do run }
!
! PR fortran/59906
!
! Contributed by H Anlauf  <anlauf@gmx.de>
!
! Failed generate character scalar for scalarized loop for elemantal call.
!
program x
  implicit none
  call y('bbb')
contains

  subroutine y(str)
    character(len=*), intent(in) :: str
    character(len=len_trim(str)) :: str_aux
    character(len=3) :: str3 = 'abc'

    str_aux = str

    ! Compiled but did not give correct result
    if (any (str_cmp((/'aaa','bbb'/), str) .neqv. [.FALSE.,.TRUE.])) call abort

    ! Did not compile
    if (any (str_cmp((/'bbb', 'aaa'/), str_aux) .neqv. [.TRUE.,.FALSE.])) call abort

    ! Verify patch
    if (any (str_cmp((/'bbb', 'aaa'/), str3) .neqv. [.FALSE.,.FALSE.])) call abort
    if (any (str_cmp((/'bbb', 'aaa'/), 'aaa') .neqv. [.FALSE.,.TRUE.])) call abort

  end subroutine y

  elemental logical function str_cmp(str1, str2)
    character(len=*), intent(in) :: str1
    character(len=*), intent(in) :: str2
    str_cmp = (str1 == str2)
  end function str_cmp

end program x