1! { dg-do compile }
2! This tests the fix for PR28735 in which an ICE would be triggered in resolve_ref
3! because the references to 'a' and 'b' in the dummy arguments of mysub have
4! no symtrees in module bar, being private there.
5!
6! Contributed by  Andrew Sampson  <adsspamtrap01@yahoo.com>
7!
8!-- foo.F -----------------------------------------------
9module foo
10  implicit none
11  public
12  integer, allocatable :: a(:), b(:)
13end module foo
14
15!-- bar.F ---------------------------------------------
16module bar
17  use foo
18  implicit none
19  private                !  This triggered the ICE
20  public :: mysub        !  since a and b are not public
21
22contains
23
24  subroutine mysub(n, parray1)
25    integer, intent(in) :: n
26    real, dimension(a(n):b(n)) :: parray1
27    if ((n == 1) .and. size(parray1, 1) /= 10) call abort ()
28    if ((n == 2) .and. size(parray1, 1) /= 42) call abort ()
29  end subroutine mysub
30end module bar
31
32!-- sub.F -------------------------------------------------------
33subroutine sub()
34
35  use foo
36  use bar
37  real :: z(100)
38  allocate (a(2), b(2))
39  a = (/1, 6/)
40  b = (/10, 47/)
41  call mysub (1, z)
42  call mysub (2, z)
43
44  return
45end
46
47!-- MAIN ------------------------------------------------------
48  use bar
49  call sub ()
50end
51