re PR fortran/60091 (Misleading error messages in rank-2 pointer assignment to rank...

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.

	PR fortran/60091
	* gfortran.dg/pointer_remapping_3.f08: Adjust error messages.
	* gfortran.dg/pointer_remapping_7.f90: Adjust error message.

From-SVN: r269717

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c46d399ff1fcf75ed08eac6fa7e9ea7292ded417..754bfebb81864c135630acb166c6648376c3a28b 100644 (file)
--- 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 08bd8e0263e538e4204adb2fdd74ea0af239a1ea..d654f4e74d04fd6b46a1d38f124ecef2520b9fb6 100644 (file)
--- 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 7acb52b1ffdeda7546e3b72c1f44c2ad8e4251ae..cad9617fc6ffd5e1a961f6f207aabff088253586 100644 (file)
--- 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 376adb07afcbf153d0a675ea379272dda1b47333..c498a364507c98bb964b1b161bf994cb18bd0126 100644 (file)
--- 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 39126bac4055cb5d02a1e425017e3b4efddd40e7..6006807fc34a80f22d94203920d8326a78c9e7a5 100644 (file)
--- 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