From eb1474baeebc8263d54ed50d532f40f777d5fabd Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Fri, 15 Mar 2019 22:20:20 +0000 Subject: [PATCH] re PR fortran/60091 (Misleading error messages in rank-2 pointer assignment to rank-1 target) 2019-03-15 Harald Anlauf PR fortran/60091 * expr.c (gfc_check_pointer_assign): Correct and improve error messages for invalid pointer assignments. PR fortran/60091 * gfortran.dg/pointer_remapping_3.f08: Adjust error messages. * gfortran.dg/pointer_remapping_7.f90: Adjust error message. From-SVN: r269717 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/expr.c | 60 +++++++++++++++---- gcc/testsuite/ChangeLog | 6 ++ .../gfortran.dg/pointer_remapping_3.f08 | 13 ++-- .../gfortran.dg/pointer_remapping_7.f90 | 2 +- 5 files changed, 67 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c46d399ff1f..754bfebb818 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2019-03-15 Harald Anlauf + + PR fortran/60091 + * expr.c (gfc_check_pointer_assign): Correct and improve error + messages for invalid pointer assignments. + 2019-03-14 Thomas Koenig * gfortran.texi: Document Q edit descriptor under diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 08bd8e0263e..d654f4e74d0 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 % " + "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 % or " + "list of % " + "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 % " + "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 % or " + "list of % " + "specifications at %L", &lvalue->where); return false; } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7acb52b1ffd..cad9617fc6f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-03-15 Harald Anlauf + + 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 PR target/87532 diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08 b/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08 index 376adb07afc..c498a364507 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 39126bac405..6006807fc34 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 -- 2.30.2