1! { dg-do run }
2! Test the fix by HJ Lu for PR23634 and friends. All involve the ICE
3! that arose from a character array constructor usedas an actual
4! argument.
5!
6! The various parts of this test are taken from the PRs.
7!
8! Test PR26491
9module global
10  public    p, line
11  interface p
12    module procedure p
13  end interface
14  character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
15contains
16  subroutine p()
17    character(128) :: word
18    word = line
19    call redirect_((/word/))
20  end subroutine
21  subroutine redirect_ (ch)
22    character(*) :: ch(:)
23    if (ch(1) /= line) STOP 1
24  end subroutine redirect_
25end module global
26
27! Test PR26550
28module my_module
29  implicit none
30  type point
31    real :: x
32  end type point
33  type(point), pointer, public :: stdin => NULL()
34contains
35  subroutine my_p(w)
36    character(128) :: w
37    call r(stdin,(/w/))
38  end subroutine my_p
39  subroutine r(ptr, io)
40    use global
41    type(point), pointer :: ptr
42    character(128) :: io(:)
43    if (associated (ptr)) STOP 2
44    if (io(1) .ne. line) STOP 3
45  end subroutine r
46end module my_module
47
48program main
49  use global
50  use my_module
51
52  integer :: i(6) = (/1,6,3,4,5,2/)
53  character (6) :: a = 'hello ', t
54  character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
55  equivalence (s, t)
56
57  call option_stopwatch_s (a) ! Call test of PR25619
58  call p ()                   ! Call test of PR26491
59  call my_p (line)            ! Call test of PR26550
60
61! Test Vivek Rao's bug, as reported in PR25619.
62  s = s(i)
63  call option_stopwatch_a ((/a,'hola! ', t/))
64
65contains
66
67! Test PR23634
68  subroutine option_stopwatch_s(a)
69    character (*), intent(in) :: a
70    character (len=len(a)) :: b
71
72    b = 'hola! '
73    call option_stopwatch_a((/a, b, 'goddag'/))
74  end subroutine option_stopwatch_s
75  subroutine option_stopwatch_a (a)
76    character (*) :: a(:)
77    if (any (a .ne. (/'hello ','hola! ','goddag'/))) STOP 4
78  end subroutine option_stopwatch_a
79
80end program main
81