1! { dg-do compile }
2!
3! PR 35381: [F95] Shape mismatch check missing for dummy procedure argument
4!
5! Contributed by Janus Weil <janus@gcc.gnu.org>
6
7module m
8
9  implicit none
10
11contains
12
13  ! constant array bounds
14
15  subroutine s1(a)
16    integer :: a(1:2)
17  end subroutine
18
19  subroutine s2(a)
20    integer :: a(2:3)
21  end subroutine
22
23  subroutine s3(a)
24    integer :: a(2:4)
25  end subroutine
26
27  ! non-constant array bounds
28
29  subroutine t1(a,b)
30    integer :: b
31    integer :: a(1:b,1:b)
32  end subroutine
33
34  subroutine t2(a,b)
35    integer :: b
36    integer :: a(1:b,2:b+1)
37  end subroutine
38
39  subroutine t3(a,b)
40    integer :: b
41    integer :: a(1:b,1:b+1)
42  end subroutine
43
44end module
45
46
47program test
48  use m
49  implicit none
50
51  call foo(s1)  ! legal
52  call foo(s2)  ! legal
53  call foo(s3)  ! { dg-error "Shape mismatch in dimension" }
54
55  call bar(t1)  ! legal
56  call bar(t2)  ! legal
57  call bar(t3)  ! { dg-error "Shape mismatch in dimension" }
58
59contains
60
61  subroutine foo(f)
62    procedure(s1) :: f
63  end subroutine
64
65  subroutine bar(f)
66    procedure(t1) :: f
67  end subroutine
68
69end program
70