diff options
author | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
---|---|---|
committer | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
commit | 1bc5aee63eb72b341f506ad058502cd0361f0d10 (patch) | |
tree | c607e8252f3405424ff15bc2d00aa38dadbb2518 /gcc-4.9/gcc/testsuite/gfortran.dg/argument_checking_13.f90 | |
parent | 283a0bf58fcf333c58a2a92c3ebbc41fb9eb1fdb (diff) | |
download | toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.gz toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.bz2 toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.zip |
Initial checkin of GCC 4.9.0 from trunk (r208799).
Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.dg/argument_checking_13.f90')
-rw-r--r-- | gcc-4.9/gcc/testsuite/gfortran.dg/argument_checking_13.f90 | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/argument_checking_13.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/argument_checking_13.f90 new file mode 100644 index 000000000..b94bbc7ec --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/argument_checking_13.f90 @@ -0,0 +1,83 @@ +! { dg-do compile } +! +! PR fortran/34796 +! +! Argument checks: +! - elements of deferred-shape arrays (= non-dummies) are allowed +! as the memory is contiguous +! - while assumed-shape arrays (= dummy arguments) and pointers are +! not (strides can make them non-contiguous) +! and +! - if the memory is non-contigous, character arguments have as +! storage size only the size of the element itself, check for +! too short actual arguments. +! +subroutine test1(assumed_sh_dummy, pointer_dummy) +implicit none +interface + subroutine rlv1(y) + real :: y(3) + end subroutine rlv1 +end interface + +real :: assumed_sh_dummy(:,:,:) +real, pointer :: pointer_dummy(:,:,:) + +real, allocatable :: deferred(:,:,:) +real, pointer :: ptr(:,:,:) +call rlv1(deferred(1,1,1)) ! valid since contiguous +call rlv1(ptr(1,1,1)) ! { dg-error "Element of assumed-shaped or pointer array" } +call rlv1(assumed_sh_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped or pointer array" } +call rlv1(pointer_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped or pointer array" } +end + +subroutine test2(assumed_sh_dummy, pointer_dummy) +implicit none +interface + subroutine rlv2(y) + character :: y(3) + end subroutine rlv2 +end interface + +character(3) :: assumed_sh_dummy(:,:,:) +character(3), pointer :: pointer_dummy(:,:,:) + +character(3), allocatable :: deferred(:,:,:) +character(3), pointer :: ptr(:,:,:) +call rlv2(deferred(1,1,1)) ! Valid since contiguous +call rlv2(ptr(1,1,1)) ! Valid F2003 +call rlv2(assumed_sh_dummy(1,1,1)) ! Valid F2003 +call rlv2(pointer_dummy(1,1,1)) ! Valid F2003 + +! The following is kind of ok: The memory access it valid +! We warn nonetheless as the result is not what is intented +! and also formally wrong. +! Using (1:string_length) would be ok. +call rlv2(ptr(1,1,1)(1:1)) ! { dg-warning "contains too few elements" } +call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" } +call rlv2(pointer_dummy(1,1,1)(1:3)) ! Valid F2003 +end + +subroutine test3(assumed_sh_dummy, pointer_dummy) +implicit none +interface + subroutine rlv3(y) + character :: y(3) + end subroutine rlv3 +end interface + +character(2) :: assumed_sh_dummy(:,:,:) +character(2), pointer :: pointer_dummy(:,:,:) + +character(2), allocatable :: deferred(:,:,:) +character(2), pointer :: ptr(:,:,:) +call rlv3(deferred(1,1,1)) ! Valid since contiguous +call rlv3(ptr(1,1,1)) ! { dg-warning "contains too few elements" } +call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-warning "contains too few elements" } +call rlv3(pointer_dummy(1,1,1)) ! { dg-warning "contains too few elements" } + +call rlv3(deferred(1,1,1)(1:2)) ! Valid since contiguous +call rlv3(ptr(1,1,1)(1:2)) ! { dg-warning "contains too few elements" } +call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" } +call rlv3(pointer_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" } +end |