blob: dfd51d65a74afc456e6114199ee4fd2da7b6cdef (
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
! { dg-do compile }
!
! PR 35381: [F95] Shape mismatch check missing for dummy procedure argument
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
module m
implicit none
contains
! constant array bounds
subroutine s1(a)
integer :: a(1:2)
end subroutine
subroutine s2(a)
integer :: a(2:3)
end subroutine
subroutine s3(a)
integer :: a(2:4)
end subroutine
! non-constant array bounds
subroutine t1(a,b)
integer :: b
integer :: a(1:b,1:b)
end subroutine
subroutine t2(a,b)
integer :: b
integer :: a(1:b,2:b+1)
end subroutine
subroutine t3(a,b)
integer :: b
integer :: a(1:b,1:b+1)
end subroutine
end module
program test
use m
implicit none
call foo(s1) ! legal
call foo(s2) ! legal
call foo(s3) ! { dg-error "Shape mismatch in dimension" }
call bar(t1) ! legal
call bar(t2) ! legal
call bar(t3) ! { dg-error "Shape mismatch in dimension" }
contains
subroutine foo(f)
procedure(s1) :: f
end subroutine
subroutine bar(f)
procedure(t1) :: f
end subroutine
end program
|
