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)
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.
15 subroutine test1(assumed_sh_dummy
, pointer_dummy
)
23 real :: assumed_sh_dummy(:,:,:)
24 real, pointer :: pointer_dummy(:,:,:)
26 real, allocatable
:: deferred(:,:,:)
27 real, pointer :: ptr(:,:,:)
28 call rlv1(deferred(1,1,1)) ! valid since contiguous
29 call rlv1(ptr(1,1,1)) ! { dg-error "Element of assumed-shaped or pointer array" }
30 call rlv1(assumed_sh_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped or pointer array" }
31 call rlv1(pointer_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped or pointer array" }
34 subroutine test2(assumed_sh_dummy
, pointer_dummy
)
42 character(3) :: assumed_sh_dummy(:,:,:)
43 character(3), pointer :: pointer_dummy(:,:,:)
45 character(3), allocatable
:: deferred(:,:,:)
46 character(3), pointer :: ptr(:,:,:)
47 call rlv2(deferred(1,1,1)) ! Valid since contiguous
48 call rlv2(ptr(1,1,1)) ! Valid F2003
49 call rlv2(assumed_sh_dummy(1,1,1)) ! Valid F2003
50 call rlv2(pointer_dummy(1,1,1)) ! Valid F2003
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.
56 call rlv2(ptr(1,1,1)(1:1)) ! { dg-warning "contains too few elements" }
57 call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
58 call rlv2(pointer_dummy(1,1,1)(1:3)) ! Valid F2003
61 subroutine test3(assumed_sh_dummy
, pointer_dummy
)
69 character(2) :: assumed_sh_dummy(:,:,:)
70 character(2), pointer :: pointer_dummy(:,:,:)
72 character(2), allocatable
:: deferred(:,:,:)
73 character(2), pointer :: ptr(:,:,:)
74 call rlv3(deferred(1,1,1)) ! Valid since contiguous
75 call rlv3(ptr(1,1,1)) ! { dg-warning "contains too few elements" }
76 call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-warning "contains too few elements" }
77 call rlv3(pointer_dummy(1,1,1)) ! { dg-warning "contains too few elements" }
79 call rlv3(deferred(1,1,1)(1:2)) ! Valid since contiguous
80 call rlv3(ptr(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
81 call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
82 call rlv3(pointer_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }