1! { dg-do compile }
2!
3! PR fortran/34796
4!
5! Argument checks:
6! - elements of deferred-shape arrays (= non-dummies) are allowed
7!   as the memory is contiguous
8! - while assumed-shape arrays (= dummy arguments) and pointers are
9!   not (strides can make them non-contiguous)
10! and
11! - if the memory is non-contigous, character arguments have as
12!   storage size only the size of the element itself, check for
13!   too short actual arguments.
14!
15subroutine test1(assumed_sh_dummy, pointer_dummy)
16implicit none
17interface
18  subroutine rlv1(y)
19    real   :: y(3)
20  end subroutine rlv1
21end interface
22
23real          :: assumed_sh_dummy(:,:,:)
24real, pointer :: pointer_dummy(:,:,:)
25
26real, allocatable :: deferred(:,:,:)
27real, pointer     :: ptr(:,:,:)
28call rlv1(deferred(1,1,1))         ! valid since contiguous
29call rlv1(ptr(1,1,1))              ! { dg-error "Element of assumed-shaped or pointer array" }
30call rlv1(assumed_sh_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped or pointer array" }
31call rlv1(pointer_dummy(1,1,1))    ! { dg-error "Element of assumed-shaped or pointer array" }
32end
33
34subroutine test2(assumed_sh_dummy, pointer_dummy)
35implicit none
36interface
37  subroutine rlv2(y)
38    character   :: y(3)
39  end subroutine rlv2
40end interface
41
42character(3)          :: assumed_sh_dummy(:,:,:)
43character(3), pointer :: pointer_dummy(:,:,:)
44
45character(3), allocatable :: deferred(:,:,:)
46character(3), pointer     :: ptr(:,:,:)
47call rlv2(deferred(1,1,1))         ! Valid since contiguous
48call rlv2(ptr(1,1,1))              ! Valid F2003
49call rlv2(assumed_sh_dummy(1,1,1)) ! Valid F2003
50call rlv2(pointer_dummy(1,1,1))    ! Valid F2003
51
52! The following is kind of ok: The memory access it valid
53! We warn nonetheless as the result is not what is intented
54! and also formally wrong.
55! Using (1:string_length) would be ok.
56call rlv2(ptr(1,1,1)(1:1))              ! { dg-warning "contains too few elements" }
57call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
58call rlv2(pointer_dummy(1,1,1)(1:3))    ! Valid F2003
59end
60
61subroutine test3(assumed_sh_dummy, pointer_dummy)
62implicit none
63interface
64  subroutine rlv3(y)
65    character   :: y(3)
66  end subroutine rlv3
67end interface
68
69character(2)          :: assumed_sh_dummy(:,:,:)
70character(2), pointer :: pointer_dummy(:,:,:)
71
72character(2), allocatable :: deferred(:,:,:)
73character(2), pointer     :: ptr(:,:,:)
74call rlv3(deferred(1,1,1))         ! Valid since contiguous
75call rlv3(ptr(1,1,1))              ! { dg-warning "contains too few elements" }
76call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-warning "contains too few elements" }
77call rlv3(pointer_dummy(1,1,1))    ! { dg-warning "contains too few elements" }
78
79call rlv3(deferred(1,1,1)(1:2))         ! Valid since contiguous
80call rlv3(ptr(1,1,1)(1:2))              ! { dg-warning "contains too few elements" }
81call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
82call rlv3(pointer_dummy(1,1,1)(1:2))    ! { dg-warning "contains too few elements" }
83end
84