[gcc/devel/omp/gcc-10] Fortran: add contiguous check for ptr assignment, fix non-contig check (PR97242)
Tobias Burnus
burnus@gcc.gnu.org
Mon Mar 1 07:40:38 GMT 2021
https://gcc.gnu.org/g:0271aca6402a77f62061880362a56cf57f3ea6b1
commit 0271aca6402a77f62061880362a56cf57f3ea6b1
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Wed Sep 30 15:01:13 2020 +0200
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.
(cherry picked from commit 65167982efa4dbb96698d026e6d7e17acb513f0a)
Diff:
---
gcc/fortran/ChangeLog.omp | 9 ++++++
gcc/fortran/expr.c | 26 ++++++++++++-----
gcc/testsuite/ChangeLog.omp | 10 +++++++
gcc/testsuite/gfortran.dg/contiguous_11.f90 | 45 +++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/contiguous_4.f90 | 6 ++--
gcc/testsuite/gfortran.dg/contiguous_7.f90 | 16 ++++++++--
6 files changed, 101 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 45c68a38914..d567ff298a2 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,12 @@
+2021-02-25 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline
+ 2020-09-30 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/97242
+ * expr.c (gfc_is_not_contiguous): Fix check.
+ (gfc_check_pointer_assign): Use it.
+
2021-02-24 Julian Brown <julian@codesourcery.com>
Backport from mainline
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6cda947cd56..fda1b2bc8f4 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4360,10 +4360,18 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
contiguous. */
if (lhs_attr.contiguous
- && lhs_attr.dimension > 0
- && !gfc_is_simply_contiguous (rvalue, false, true))
- gfc_warning (OPT_Wextra, "Assignment to contiguous pointer from "
- "non-contiguous target at %L", &rvalue->where);
+ && lhs_attr.dimension > 0)
+ {
+ if (gfc_is_not_contiguous (rvalue))
+ {
+ gfc_error ("Assignment to contiguous pointer from "
+ "non-contiguous target at %L", &rvalue->where);
+ return false;
+ }
+ if (!gfc_is_simply_contiguous (rvalue, false, true))
+ gfc_warning (OPT_Wextra, "Assignment to contiguous pointer from "
+ "non-contiguous target at %L", &rvalue->where);
+ }
/* Warn if it is the LHS pointer may lives longer than the RHS target. */
if (warn_target_lifetime
@@ -5931,7 +5939,7 @@ gfc_is_not_contiguous (gfc_expr *array)
{
/* Array-ref shall be last ref. */
- if (ar)
+ if (ar && ar->type != AR_ELEMENT)
return true;
if (ref->type == REF_ARRAY)
@@ -5951,10 +5959,11 @@ gfc_is_not_contiguous (gfc_expr *array)
if (gfc_ref_dimen_size (ar, i, &ref_size, NULL))
{
- if (gfc_dep_difference (ar->as->lower[i], ar->as->upper[i], &arr_size))
+ if (gfc_dep_difference (ar->as->upper[i], ar->as->lower[i], &arr_size))
{
/* a(2:4,2:) is known to be non-contiguous, but
a(2:4,i:i) can be contiguous. */
+ mpz_add_ui (arr_size, arr_size, 1L);
if (previous_incomplete && mpz_cmp_si (ref_size, 1) != 0)
{
mpz_clear (arr_size);
@@ -5975,7 +5984,10 @@ gfc_is_not_contiguous (gfc_expr *array)
&& ar->dimen_type[i] == DIMEN_RANGE
&& ar->stride[i] && ar->stride[i]->expr_type == EXPR_CONSTANT
&& mpz_cmp_si (ar->stride[i]->value.integer, 1) != 0)
- return true;
+ {
+ mpz_clear (ref_size);
+ return true;
+ }
mpz_clear (ref_size);
}
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index f056b3c8f23..d010ff87307 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,13 @@
+2021-02-25 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline
+ 2020-09-30 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/97242
+ * gfortran.dg/contiguous_11.f90: New test.
+ * gfortran.dg/contiguous_4.f90: Update.
+ * gfortran.dg/contiguous_7.f90: Update.
+
2021-02-24 Julian Brown <julian@codesourcery.com>
Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/contiguous_11.f90 b/gcc/testsuite/gfortran.dg/contiguous_11.f90
new file mode 100644
index 00000000000..b7eb7bfd0b4
--- /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 874ef8ba9ec..e784287c00d 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 cccc89f9ba4..7444b4c5c30 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
More information about the Gcc-cvs
mailing list