aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog6
-rw-r--r--gcc/fortran/expr.c60
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/pointer_remapping_3.f0813
-rw-r--r--gcc/testsuite/gfortran.dg/pointer_remapping_7.f902
5 files changed, 67 insertions, 20 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c46d399..754bfeb 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-15 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/60091
+ * expr.c (gfc_check_pointer_assign): Correct and improve error
+ messages for invalid pointer assignments.
+
2019-03-14 Thomas Koenig <tkoenig@gcc.gnu.org>
* gfortran.texi: Document Q edit descriptor under
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 08bd8e0..d654f4e7 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3703,6 +3703,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
gfc_ref *ref;
bool is_pure, is_implicit_pure, rank_remap;
int proc_pointer;
+ bool same_rank;
lhs_attr = gfc_expr_attr (lvalue);
if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
@@ -3724,6 +3725,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
proc_pointer = lvalue->symtree->n.sym->attr.proc_pointer;
rank_remap = false;
+ same_rank = lvalue->rank == rvalue->rank;
for (ref = lvalue->ref; ref; ref = ref->next)
{
if (ref->type == REF_COMPONENT)
@@ -3748,22 +3750,47 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
lvalue->symtree->n.sym->name, &lvalue->where))
return false;
- /* When bounds are given, all lbounds are necessary and either all
- or none of the upper bounds; no strides are allowed. If the
- upper bounds are present, we may do rank remapping. */
+ /* Fortran standard (e.g. F2018, 10.2.2 Pointer assignment):
+ *
+ * (C1017) If bounds-spec-list is specified, the number of
+ * bounds-specs shall equal the rank of data-pointer-object.
+ *
+ * If bounds-spec-list appears, it specifies the lower bounds.
+ *
+ * (C1018) If bounds-remapping-list is specified, the number of
+ * bounds-remappings shall equal the rank of data-pointer-object.
+ *
+ * If bounds-remapping-list appears, it specifies the upper and
+ * lower bounds of each dimension of the pointer; the pointer target
+ * shall be simply contiguous or of rank one.
+ *
+ * (C1019) If bounds-remapping-list is not specified, the ranks of
+ * data-pointer-object and data-target shall be the same.
+ *
+ * Thus when bounds are given, all lbounds are necessary and either
+ * all or none of the upper bounds; no strides are allowed. If the
+ * upper bounds are present, we may do rank remapping. */
for (dim = 0; dim < ref->u.ar.dimen; ++dim)
{
- if (!ref->u.ar.start[dim]
- || ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
+ if (ref->u.ar.stride[dim])
{
- gfc_error ("Lower bound has to be present at %L",
+ gfc_error ("Stride must not be present at %L",
&lvalue->where);
return false;
}
- if (ref->u.ar.stride[dim])
+ if (!same_rank && (!ref->u.ar.start[dim] ||!ref->u.ar.end[dim]))
{
- gfc_error ("Stride must not be present at %L",
- &lvalue->where);
+ gfc_error ("Rank remapping requires a "
+ "list of %<lower-bound : upper-bound%> "
+ "specifications at %L", &lvalue->where);
+ return false;
+ }
+ if (!ref->u.ar.start[dim]
+ || ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
+ {
+ gfc_error ("Expected list of %<lower-bound :%> or "
+ "list of %<lower-bound : upper-bound%> "
+ "specifications at %L", &lvalue->where);
return false;
}
@@ -3771,11 +3798,18 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
rank_remap = (ref->u.ar.end[dim] != NULL);
else
{
- if ((rank_remap && !ref->u.ar.end[dim])
- || (!rank_remap && ref->u.ar.end[dim]))
+ if ((rank_remap && !ref->u.ar.end[dim]))
+ {
+ gfc_error ("Rank remapping requires a "
+ "list of %<lower-bound : upper-bound%> "
+ "specifications at %L", &lvalue->where);
+ return false;
+ }
+ if (!rank_remap && ref->u.ar.end[dim])
{
- gfc_error ("Either all or none of the upper bounds"
- " must be specified at %L", &lvalue->where);
+ gfc_error ("Expected list of %<lower-bound :%> or "
+ "list of %<lower-bound : upper-bound%> "
+ "specifications at %L", &lvalue->where);
return false;
}
}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7acb52b..cad9617 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-15 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/60091
+ * gfortran.dg/pointer_remapping_3.f08: Adjust error messages.
+ * gfortran.dg/pointer_remapping_7.f90: Adjust error message.
+
2019-03-15 Kelvin Nilsen <kelvin@gcc.gnu.org>
PR target/87532
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08 b/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08
index 376adb0..c498a36 100644
--- a/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08
@@ -3,6 +3,7 @@
! PR fortran/29785
! PR fortran/45016
+! PR fortran/60091
! Check for pointer remapping compile-time errors.
! Contributed by Daniel Kraft, d@domob.eu.
@@ -13,13 +14,13 @@ PROGRAM main
INTEGER, POINTER :: vec(:), mat(:, :)
! Existence of reference elements.
- vec(:) => arr ! { dg-error "Lower bound has to be present" }
- vec(5:7:1) => arr ! { dg-error "Stride must not be present" }
- mat(1:, 2:5) => arr ! { dg-error "Either all or none of the upper bounds" }
- mat(2, 6) => arr ! { dg-error "Expected bounds specification" }
+ vec(:) => arr ! { dg-error "or list of 'lower-bound : upper-bound'" }
+ vec(5:7:1) => arr ! { dg-error "Stride must not be present" }
+ mat(1:,2:5) => arr ! { dg-error "Rank remapping requires a list of " }
+ mat(1:3,4:) => arr ! { dg-error "Rank remapping requires a list of " }
+ mat(2, 6) => arr ! { dg-error "Expected bounds specification" }
- ! This is bound remapping not rank remapping!
- mat(1:, 3:) => arr ! { dg-error "Different ranks" }
+ mat(1:,3:) => arr ! { dg-error "Rank remapping requires a list of " }
! Invalid remapping target; for non-rank one we already check the F2008
! error elsewhere. Here, test that not-contiguous target is disallowed
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_7.f90 b/gcc/testsuite/gfortran.dg/pointer_remapping_7.f90
index 39126ba..6006807 100644
--- a/gcc/testsuite/gfortran.dg/pointer_remapping_7.f90
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_7.f90
@@ -4,5 +4,5 @@
!
integer, target :: A(100)
integer,pointer :: P(:,:)
- p(10,1:) => A ! { dg-error "Lower bound has to be present" }
+ p(10,1:) => A ! { dg-error "or list of 'lower-bound : upper-bound'" }
end
generated by cgit v1.1 at 2025-04-30 05:46:59 +0000