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