diff mbox series

[fortran] Fix PR 71237

Message ID bfba2ba9-5d4c-ba37-5cc7-844739eba26a@netcologne.de
State New
Headers show
Series [fortran] Fix PR 71237 | expand

Commit Message

Thomas Koenig Feb. 6, 2019, 8:27 p.m. UTC 
Hello world,

this patch fixes a 7/8/9 regression where we tried to accept invalid
code, which led to an ICE later on.

The patch is rather straightforward.  The reason why I could not
use gfc_expr_attr is that it does not actually return the
flags the way they can be found in the original attributes;
for example, an expression containing a pointer attribute is
shown as having the target attribute, for reasons I cannot
fathom.

Regression-tested.  OK for trunk and other open branches?

Regards

	Thomas

2019-02-06  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/71237
	* expr.c (gfc_check_assign): Add argument is_init_expr.  If we are
	looking at an init expression, issue error if the target is not a
	TARGET and we are not looking at a procedure pointer.
	* gfortran.h (gfc_check_assign): Add optional argument
	is_init_expr.

2019-02-06  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/71237
	* gfortran.dg/pointer_init_2.f90: Adjust error messages.
	* gfortran.dg/pointer_init_6.f90: Likewise.
	* gfortran.dg/pointer_init_9.f90: New test.

Comments

Thomas Koenig Feb. 10, 2019, 11:15 a.m. UTC | #1 
Am 06.02.19 um 21:27 schrieb Thomas Koenig:
> Hello world,
> 
> this patch fixes a 7/8/9 regression where we tried to accept invalid
> code, which led to an ICE later on.
> 
> The patch is rather straightforward.  The reason why I could not
> use gfc_expr_attr is that it does not actually return the
> flags the way they can be found in the original attributes;
> for example, an expression containing a pointer attribute is
> shown as having the target attribute, for reasons I cannot
> fathom.
> 
> Regression-tested.  OK for trunk and other open branches?

Ping?

And please disregard the ChangeLog entry in the patch :-)

Regards

	Thomas
Paul Richard Thomas Feb. 10, 2019, 2:57 p.m. UTC | #2 
OK. Thanks for the patch.

Paul

On Wed, 6 Feb 2019 at 20:27, Thomas Koenig <tkoenig@netcologne.de> wrote:
>
> Hello world,
>
> this patch fixes a 7/8/9 regression where we tried to accept invalid
> code, which led to an ICE later on.
>
> The patch is rather straightforward.  The reason why I could not
> use gfc_expr_attr is that it does not actually return the
> flags the way they can be found in the original attributes;
> for example, an expression containing a pointer attribute is
> shown as having the target attribute, for reasons I cannot
> fathom.
>
> Regression-tested.  OK for trunk and other open branches?
>
> Regards
>
>         Thomas
>
> 2019-02-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
>
>         PR fortran/71237
>         * expr.c (gfc_check_assign): Add argument is_init_expr.  If we are
>         looking at an init expression, issue error if the target is not a
>         TARGET and we are not looking at a procedure pointer.
>         * gfortran.h (gfc_check_assign): Add optional argument
>         is_init_expr.
>
> 2019-02-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
>
>         PR fortran/71237
>         * gfortran.dg/pointer_init_2.f90: Adjust error messages.
>         * gfortran.dg/pointer_init_6.f90: Likewise.
>         * gfortran.dg/pointer_init_9.f90: New test.
diff mbox series

Patch

Index: fortran/ChangeLog
===================================================================
--- fortran/ChangeLog	(Revision 268501)
+++ fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,11 @@ 
+2019-02-05  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/67679
+	Backport from trunk
+	* trans-array.c (gfc_array_allocate):  For setting the bounds on
+	the new array, add a condition for a not previously allocated
+	variable.
+
 2019-02-02  Dominique d'Humieres  <dominiq@gcc.gnu.org>
 
 	PR fortran/81344
Index: fortran/expr.c
===================================================================
--- fortran/expr.c	(Revision 268432)
+++ fortran/expr.c	(Arbeitskopie)
@@ -3682,7 +3682,7 @@  gfc_check_assign (gfc_expr *lvalue, gfc_expr *rval
 
 bool
 gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
-			  bool suppress_type_test)
+			  bool suppress_type_test, bool is_init_expr)
 {
   symbol_attribute attr, lhs_attr;
   gfc_ref *ref;
@@ -4124,12 +4124,36 @@  gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
       return false;
     }
 
-  if (!attr.target && !attr.pointer)
+  if (is_init_expr)
     {
-      gfc_error ("Pointer assignment target is neither TARGET "
-		 "nor POINTER at %L", &rvalue->where);
-      return false;
+      gfc_symbol *sym;
+      bool target;
+
+      gcc_assert (rvalue->symtree);
+      sym = rvalue->symtree->n.sym;
+
+      if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+	target = CLASS_DATA (sym)->attr.target;
+      else
+	target = sym->attr.target;
+
+      if (!target && !proc_pointer)
+	{
+	  gfc_error ("Pointer assignment target in initialization expression "
+		     "does not have the TARGET attribute at %L",
+		     &rvalue->where);
+	  return false;
+	}
     }
+  else
+    {
+      if (!attr.target && !attr.pointer)
+	{
+	  gfc_error ("Pointer assignment target is neither TARGET "
+		     "nor POINTER at %L", &rvalue->where);
+	  return false;
+	}
+    }
 
   if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym))
     {
@@ -4262,7 +4286,7 @@  gfc_check_assign_symbol (gfc_symbol *sym, gfc_comp
     }
 
   if (pointer || proc_pointer)
-    r = gfc_check_pointer_assign (&lvalue, rvalue);
+    r = gfc_check_pointer_assign (&lvalue, rvalue, false, true);
   else
     {
       /* If a conversion function, e.g., __convert_i8_i4, was inserted
Index: fortran/gfortran.h
===================================================================
--- fortran/gfortran.h	(Revision 268475)
+++ fortran/gfortran.h	(Arbeitskopie)
@@ -3247,7 +3247,8 @@  int gfc_kind_max (gfc_expr *, gfc_expr *);
 bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
 bool gfc_check_assign (gfc_expr *, gfc_expr *, int, bool c = true);
 bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
-  bool suppres_type_test = false);
+			       bool suppres_type_test = false,
+			       bool is_init_expr = false);
 bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
 
 gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *);
Index: testsuite/gfortran.dg/pointer_init_2.f90
===================================================================
--- testsuite/gfortran.dg/pointer_init_2.f90	(Revision 268432)
+++ testsuite/gfortran.dg/pointer_init_2.f90	(Arbeitskopie)
@@ -18,7 +18,7 @@  subroutine sub
   integer, pointer :: dp0 => 13  ! { dg-error "Error in pointer initialization" }
   integer, pointer :: dp1 => r   ! { dg-error "Different types in pointer assignment" }
   integer, pointer :: dp2 => v   ! { dg-error "Different ranks in pointer assignment" }
-  integer, pointer :: dp3 => i   ! { dg-error "is neither TARGET nor POINTER" }
+  integer, pointer :: dp3 => i   ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" }
   integer, pointer :: dp4 => j   ! { dg-error "must have the SAVE attribute" }
   integer, pointer :: dp5 => a   ! { dg-error "must not be ALLOCATABLE" }
 
@@ -35,7 +35,7 @@  subroutine sub
   end type t3
 
   type t4
-    integer, pointer :: dpc3 => i   ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" }
+    integer, pointer :: dpc3 => i   ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" }
   end type t4
 
   type t5
Index: testsuite/gfortran.dg/pointer_init_6.f90
===================================================================
--- testsuite/gfortran.dg/pointer_init_6.f90	(Revision 268432)
+++ testsuite/gfortran.dg/pointer_init_6.f90	(Arbeitskopie)
@@ -13,7 +13,7 @@  module m1
  integer, target :: i
  type(t), target :: x
  integer, pointer :: p1 => i
- integer, pointer :: p2 => p1   ! { dg-error "must have the TARGET attribute" }
+ integer, pointer :: p2 => p1   ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute at" }
  integer, pointer :: p3 => x%p  ! { dg-error "must have the TARGET attribute" }
  integer, pointer :: p4 => x%i
  integer, pointer :: p5 => u    ! { dg-error "has no IMPLICIT type" }