1! PR rtl-optimization/55330
2! { dg-do compile }
3! { dg-options "-O -fPIC -fno-dse -fno-guess-branch-probability" }
4
5module global
6  public    p, line
7  interface p
8    module procedure p
9  end interface
10  character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
11contains
12  subroutine p()
13    character(128) :: word
14    word = line
15    call redirect_((/word/))
16  end subroutine
17  subroutine redirect_ (ch)
18    character(*) :: ch(:)
19    if (ch(1) /= line) call abort ()
20  end subroutine redirect_
21end module global
22
23module my_module
24  implicit none
25  type point
26    real :: x
27  end type point
28  type(point), pointer, public :: stdin => NULL()
29contains
30  subroutine my_p(w)
31    character(128) :: w
32    call r(stdin,(/w/))
33  end subroutine my_p
34  subroutine r(ptr, io)
35    use global
36    type(point), pointer :: ptr
37    character(128) :: io(:)
38    if (associated (ptr)) call abort ()
39    if (io(1) .ne. line) call abort ()
40  end subroutine r
41end module my_module
42
43program main
44  use global
45  use my_module
46
47  integer :: i(6) = (/1,6,3,4,5,2/)
48  character (6) :: a = 'hello ', t
49  character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
50  equivalence (s, t)
51
52  call option_stopwatch_s (a)
53  call p ()
54  call my_p (line)
55
56  s = s(i)
57  call option_stopwatch_a ((/a,'hola! ', t/))
58
59contains
60
61  subroutine option_stopwatch_s(a)
62    character (*), intent(in) :: a
63    character (len=len(a)) :: b
64
65    b = 'hola! '
66    call option_stopwatch_a((/a, b, 'goddag'/))
67  end subroutine option_stopwatch_s
68  subroutine option_stopwatch_a (a)
69    character (*) :: a(:)
70    if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort ()
71  end subroutine option_stopwatch_a
72
73end program main
74