re PR fortran/71723 ([F08] ICE on invalid pointer initialization)

2019-02-10  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-10  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.

From-SVN: r268748

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b5a4c0a2f64788d88608377769005593fe2667a3..73c42796fba9f90cd440c878a2f9a3da4c8d9ac6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2019-02-10  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-09  Harald Anlauf  <anlauf@gmx.de>
 
        PR fortran/89077

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a0eb94fbbccffe4f25fbf7d1b529c1b6ec687913..c3d78d358cf694473942dc7ed02b870325a3fb86 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3691,7 +3691,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
 
 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;
@@ -4133,11 +4133,35 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
       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))
@@ -4271,7 +4295,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
     }
 
   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

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9643deba129b19c9214ce64522e76f3f71b57d32..0a0fef81d9fb7ee0820e88108e2541e042405ede 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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 *);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 789f5ad3c91474b89175c1264eb231900862aa67..c70ec9f270474f064b69e4c03dd684070cd7895d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,7 +1,14 @@
+2019-02-10  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.
+
 2019-02-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/67679
-       * gfortran.dg/warn_undefined_1.f90: New test.
+       * gfortran.dg/warn_undefined_1.f90: New test.o
 
 2019-02-10  Jakub Jelinek  <jakub@redhat.com>
 

diff --git a/gcc/testsuite/gfortran.dg/pointer_init_2.f90 b/gcc/testsuite/gfortran.dg/pointer_init_2.f90
index a280a3e4f989f49cbc179544f60bae808aac67a2..bc1ef74ec5590a2cb04869c74f6a3b6bb7000b5b 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pointer_init_2.f90
+++ b/gcc/testsuite/gfortran.dg/pointer_init_2.f90
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/pointer_init_6.f90 b/gcc/testsuite/gfortran.dg/pointer_init_6.f90
index f5e7555c4a77dba7ee226df1042faa17f0c4ac76..3abad4ae1795f5dc739651a8f83987cdd6622a74 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pointer_init_6.f90
+++ b/gcc/testsuite/gfortran.dg/pointer_init_6.f90
@@ -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" }

diff --git a/gcc/testsuite/gfortran.dg/pointer_init_9.f90 b/gcc/testsuite/gfortran.dg/pointer_init_9.f90
new file mode 100644 (file)
index 0000000..da00330
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_9.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR 71237 - this used to ICE.
+module data_mod
+  implicit none
+
+  type data_t
+    integer :: i
+  end type
+
+  type(data_t), pointer :: data
+  integer, pointer :: idata => data%i ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" }
+
+end module