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

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

gcc/fortran/ChangeLog

+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

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;
 		    }
 		}

gcc/testsuite/ChangeLog

+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

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

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