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
|
! { dg-do compile }
! PR 92004 - checks in the absence of an explicit interface between
! array elements and arrays
module x
implicit none
type t
real :: x
end type t
type tt
real :: x(2)
end type tt
type pointer_t
real, pointer :: x(:)
end type pointer_t
type alloc_t
real, dimension(:), allocatable :: x
end type alloc_t
contains
subroutine foo(a)
real, dimension(:) :: a
real, dimension(2), parameter :: b = [1.0, 2.0]
real, dimension(10) :: x
type (t), dimension(1) :: vv
type (pointer_t) :: pointer_v
real, dimension(:), pointer :: p
call invalid_1(a(1)) ! { dg-error "Rank mismatch" }
call invalid_1(a) ! { dg-error "Rank mismatch" }
call invalid_2(a) ! { dg-error "Element of assumed-shape or pointer" }
call invalid_2(a(1)) ! { dg-error "Element of assumed-shape or pointer" }
call invalid_3(b) ! { dg-error "Rank mismatch" }
call invalid_3(1.0) ! { dg-error "Rank mismatch" }
call invalid_4 (vv(1)%x) ! { dg-error "Rank mismatch" }
call invalid_4 (b) ! { dg-error "Rank mismatch" }w
call invalid_5 (b) ! { dg-error "Rank mismatch" }
call invalid_5 (vv(1)%x) ! { dg-error "Rank mismatch" }
call invalid_6 (x) ! { dg-error "cannot correspond to actual argument" }
call invalid_6 (pointer_v%x(1)) ! { dg-error "cannot correspond to actual argument" }
call invalid_7 (pointer_v%x(1)) ! { dg-error "Rank mismatch" }
call invalid_7 (x) ! { dg-error "Rank mismatch" }
call invalid_8 (p(1)) ! { dg-error "Rank mismatch" }
call invalid_8 (x) ! { dg-error "Rank mismatch" }
call invalid_9 (x) ! { dg-error "cannot correspond to actual argument" }
call invalid_9 (p(1)) ! { dg-error "cannot correspond to actual argument" }
end subroutine foo
subroutine bar(a, alloc)
real, dimension(*) :: a
real, dimension(2), parameter :: b = [1.0, 2.0]
type (alloc_t), pointer :: alloc
type (tt) :: tt_var
! None of the ones below should issue an error.
call valid_1 (a)
call valid_1 (a(1))
call valid_2 (a(1))
call valid_2 (a)
call valid_3 (b)
call valid_3 (b(1))
call valid_4 (tt_var%x)
call valid_4 (tt_var%x(1))
call valid_5 (alloc%x(1))
call valid_5 (a)
end subroutine bar
end module x
|