diff options
| author | Tobias Burnus <tobias@codesourcery.com> | 2020-09-30 15:01:13 +0200 |
|---|---|---|
| committer | Tobias Burnus <tobias@codesourcery.com> | 2020-09-30 15:01:13 +0200 |
| commit | 65167982efa4dbb96698d026e6d7e17acb513f0a (patch) | |
| tree | 3d5bc9c39be8e950bd889436ee84d1148c0ae582 /gcc/testsuite/gfortran.dg | |
| parent | 8b0a63e47cd83f4e8534d0d201739bdd10f321a2 (diff) | |
| download | gcc-65167982efa4dbb96698d026e6d7e17acb513f0a.zip gcc-65167982efa4dbb96698d026e6d7e17acb513f0a.tar.gz gcc-65167982efa4dbb96698d026e6d7e17acb513f0a.tar.bz2 | |
Fortran: add contiguous check for ptr assignment, fix non-contig check (PR97242)
gcc/fortran/ChangeLog:
PR fortran/97242
* expr.c (gfc_is_not_contiguous): Fix check.
(gfc_check_pointer_assign): Use it.
gcc/testsuite/ChangeLog:
PR fortran/97242
* gfortran.dg/contiguous_11.f90: New test.
* gfortran.dg/contiguous_4.f90: Update.
* gfortran.dg/contiguous_7.f90: Update.
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/contiguous_11.f90 | 45 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/contiguous_4.f90 | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/contiguous_7.f90 | 16 |
3 files changed, 63 insertions, 4 deletions
diff --git a/gcc/testsuite/gfortran.dg/contiguous_11.f90 b/gcc/testsuite/gfortran.dg/contiguous_11.f90 new file mode 100644 index 0000000..b7eb7bf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/contiguous_11.f90 @@ -0,0 +1,45 @@ +! { dg-do compile } +! +! PR fortran/97242 +! +implicit none +type t + integer, allocatable :: A(:,:,:) + integer :: D(5,5,5) +end type t + +type(t), target :: B(5) +integer, pointer, contiguous :: P(:,:,:) +integer, target :: C(5,5,5) +integer :: i + +i = 1 + +! OK: contiguous +P => B(i)%A +P => B(i)%A(:,:,:) +P => C +P => C(:,:,:) +call foo (B(i)%A) +call foo (B(i)%A(:,:,:)) +call foo (C) +call foo (C(:,:,:)) + +! Invalid - not contiguous +! "If the pointer object has the CONTIGUOUS attribute, the pointer target shall be contiguous." +! → known to be noncontigous (not always checkable, however) +P => B(i)%A(:,::3,::4) ! <<< Unknown as (1:2:3,1:3:4) is contiguous and has one element. +P => B(i)%D(:,::2,::2) ! { dg-error "Assignment to contiguous pointer from non-contiguous target" } +P => C(::2,::2,::2) ! { dg-error "Assignment to contiguous pointer from non-contiguous target" } + +! This following is stricter: +! C1541 The actual argument corresponding to a dummy pointer with the +! CONTIGUOUS attribute shall be simply contiguous (9.5.4). +call foo (B(i)%A(:,::3,::4)) ! { dg-error "must be simply contiguous" } +call foo (C(::2,::2,::2)) ! { dg-error "must be simply contiguous" } + +contains + subroutine foo(Q) + integer, pointer, intent(in), contiguous :: Q(:,:,:) + end subroutine foo +end diff --git a/gcc/testsuite/gfortran.dg/contiguous_4.f90 b/gcc/testsuite/gfortran.dg/contiguous_4.f90 index 874ef8b..e784287 100644 --- a/gcc/testsuite/gfortran.dg/contiguous_4.f90 +++ b/gcc/testsuite/gfortran.dg/contiguous_4.f90 @@ -10,8 +10,10 @@ program cont_01_neg x = (/ (real(i),i=1,45) /) x2 = reshape(x,shape(x2)) - r => x(::3) - r2 => x2(2:,:) + r => x(::46) + r => x(::3) ! { dg-error "Assignment to contiguous pointer from non-contiguous target" } + r2 => x2(2:,9:) + r2 => x2(2:,:) ! { dg-error "Assignment to contiguous pointer from non-contiguous target" } r2 => x2(:,2:3) r => x2(2:3,1) r => x(::1) diff --git a/gcc/testsuite/gfortran.dg/contiguous_7.f90 b/gcc/testsuite/gfortran.dg/contiguous_7.f90 index cccc89f..7444b4c 100644 --- a/gcc/testsuite/gfortran.dg/contiguous_7.f90 +++ b/gcc/testsuite/gfortran.dg/contiguous_7.f90 @@ -8,17 +8,29 @@ program cont_01_neg implicit none real, pointer, contiguous :: r(:) real, pointer, contiguous :: r2(:,:) - real, target :: x(45) - real, target :: x2(5,9) + real, target, allocatable :: x(:) + real, target, allocatable :: x2(:,:) + real, target :: y(45) + real, target :: y2(5,9) integer :: i integer :: n=1 x = (/ (real(i),i=1,45) /) x2 = reshape(x,shape(x2)) + y = x + y2 = x2 + r => x(::3) ! { dg-warning "ssignment to contiguous pointer from non-contiguous target" } r2 => x2(2:,:) ! { dg-warning "ssignment to contiguous pointer from non-contiguous target" } r2 => x2(:,2:3) r => x2(2:3,1) r => x(::1) r => x(::n) ! { dg-warning "ssignment to contiguous pointer from non-contiguous target" } + + r => y(::3) ! { dg-error "ssignment to contiguous pointer from non-contiguous target" } + r2 => y2(2:,:) ! { dg-error "ssignment to contiguous pointer from non-contiguous target" } + r2 => y2(:,2:3) + r => y2(2:3,1) + r => y(::1) + r => y(::n) ! { dg-warning "ssignment to contiguous pointer from non-contiguous target" } end program |