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