[PR,fortran/60091] - Misleading error messages in rank-2 pointer assignment to rank-1 target

Message ID 5C819E51.6000205@gmx.de
State New
Headers show
Series
  • [PR,fortran/60091] - Misleading error messages in rank-2 pointer assignment to rank-1 target
Related show

Commit Message

Harald Anlauf March 7, 2019, 10:42 p.m.
The PR rightly complains about bad error messages for invalid pointer
assignments.  I've tried to adjust the logic slightly so that we now
print error messages that should explain more clearly what is wrong.

This required adjustment of 2 testcases, one of which also had an
incorrect comment.

OK for trunk?

Thanks,
Harald

2019-03-07  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-07  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.

Index: gcc/testsuite/gfortran.dg/pointer_remapping_3.f08
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_remapping_3.f08	(revision 269445)
+++ gcc/testsuite/gfortran.dg/pointer_remapping_3.f08	(working copy)
@@ -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 @@
   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 "bounds-remapping-list or bounds-specification-list" }
+  vec(5:7:1)  => arr ! { dg-error "Stride must not be present" }
+  mat(1:,2:5) => arr ! { dg-error "requires a bounds-specification-list" }
+  mat(1:3,4:) => arr ! { dg-error "requires a bounds-specification-list" }
+  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 "requires a bounds-specification-list" }
 
   ! Invalid remapping target; for non-rank one we already check the F2008
   ! error elsewhere.  Here, test that not-contiguous target is disallowed
Index: gcc/testsuite/gfortran.dg/pointer_remapping_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_remapping_7.f90	(revision 269445)
+++ gcc/testsuite/gfortran.dg/pointer_remapping_7.f90	(working copy)
@@ -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 "Expected bounds-remapping-list" }
   end

Patch

Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 269445)
+++ gcc/fortran/expr.c	(working copy)
@@ -3703,6 +3703,7 @@ 
   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 @@ 
   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,36 +3750,67 @@ 
 			       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",
+		  gfc_error ("Rank remapping requires a "
+			     "bounds-specification-list at %L",
 			     &lvalue->where);
 		  return false;
 		}
+	      if (!ref->u.ar.start[dim]
+		  || ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
+		{
+		  gfc_error ("Expected bounds-remapping-list or "
+			     "bounds-specification-list at %L",
+			     &lvalue->where);
+		  return false;
+		}
 
 	      if (dim == 0)
 		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 ("Either all or none of the upper bounds"
-				 " must be specified at %L", &lvalue->where);
+		      gfc_error ("Rank remapping requires a "
+				 "bounds-specification-list at %L",
+				 &lvalue->where);
 		      return false;
 		    }
+		  if (!rank_remap && ref->u.ar.end[dim])
+		    {
+		      gfc_error ("Expected bounds-remapping-list or "
+				 "bounds-specification-list at %L",
+				 &lvalue->where);
+		    }
 		}
 	    }
 	}