re PR fortran/83076 (ICE in gfc_deallocate_scalar_with_status, at fortran/trans.c...

2018-01-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/83076
	* resolve.c (resolve_fl_derived0): Add caf_token fields for
	allocatable and pointer scalars, when -fcoarray selected.
	* trans-types.c (gfc_copy_dt_decls_ifequal): Copy the token
	field as well as the backend_decl.
	(gfc_get_derived_type): Flag GFC_FCOARRAY_LIB for module
	derived types that are not vtypes. Components with caf_token
	attribute are pvoid types. For a component requiring it, find
	the caf_token field and have the component token field point to
	its backend_decl.

	PR fortran/83319
	*trans-types.c (gfc_get_array_descriptor_base): Add the token
	field to the descriptor even when codimen not set.

2018-01-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/83076
	* gfortran.dg/coarray_45.f90 : New test.

	PR fortran/83319
	* gfortran.dg/coarray_46.f90 : New test.

From-SVN: r256065

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 678ffc684694560ce485e43f9954ea5b3a6a120a..ad2ff35b610503c2f0c4e0e544e223d141272aa0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2018-01-01  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/83076
+       * resolve.c (resolve_fl_derived0): Add caf_token fields for
+       allocatable and pointer scalars, when -fcoarray selected.
+       * trans-types.c (gfc_copy_dt_decls_ifequal): Copy the token
+       field as well as the backend_decl.
+       (gfc_get_derived_type): Flag GFC_FCOARRAY_LIB for module
+       derived types that are not vtypes. Components with caf_token
+       attribute are pvoid types. For a component requiring it, find
+       the caf_token field and have the component token field point to
+       its backend_decl.
+
+       PR fortran/83319
+       *trans-types.c (gfc_get_array_descriptor_base): Add the token
+       field to the descriptor even when codimen not set.
+
 2017-12-28  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR Fortran/83548

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7b837c9fe508880ab15eb5203c71402f07daef71..662d34f7c0aefac1f720e9ba8b115000160d8ac2 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -870,7 +870,7 @@ typedef struct
   unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
           private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1,
           event_comp:1, defined_assign_comp:1, unlimited_polymorphic:1,
-          has_dtio_procs:1;
+          has_dtio_procs:1, caf_token:1;
 
   /* This is a temporary selector for SELECT TYPE or an associate
      variable for SELECT_TYPE or ASSOCIATE.  */

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index cf75a78d7bae1bed546a8699ffef6f9026a8b9d7..c1d8a426dc9d3ed6a640719c6c7cf2e485e086f3 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -13993,6 +13993,31 @@ resolve_fl_derived0 (gfc_symbol *sym)
   if (!success)
     return false;
 
+  /* Now add the caf token field, where needed.  */
+  if (flag_coarray != GFC_FCOARRAY_NONE
+      && !sym->attr.is_class && !sym->attr.vtype)
+    {
+      for (c = sym->components; c; c = c->next)
+       if (!c->attr.dimension && !c->attr.codimension
+           && (c->attr.allocatable || c->attr.pointer))
+         {
+           char name[GFC_MAX_SYMBOL_LEN+9];
+           gfc_component *token;
+           sprintf (name, "_caf_%s", c->name);
+           token = gfc_find_component (sym, name, true, true, NULL);
+           if (token == NULL)
+             {
+               if (!gfc_add_component (sym, name, &token))
+                 return false;
+               token->ts.type = BT_VOID;
+               token->ts.kind = gfc_default_integer_kind;
+               token->attr.access = ACCESS_PRIVATE;
+               token->attr.artificial = 1;
+               token->attr.caf_token = 1;
+             }
+         }
+    }
+
   check_defined_assignments (sym);
 
   if (!sym->attr.defined_assign_comp && super_type)

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 6868329575b8e1818a53358e5e31e0b3843e2774..73f75ccf58be92da987a54338b22c813b32c8499 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1837,7 +1837,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
       TREE_NO_WARNING (decl) = 1;
     }
 
-  if (flag_coarray == GFC_FCOARRAY_LIB && codimen)
+  if (flag_coarray == GFC_FCOARRAY_LIB)
     {
       decl = gfc_add_field_to_struct_1 (fat_type,
                                        get_identifier ("token"),
@@ -2373,6 +2373,7 @@ gfc_copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to,
   for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next)
     {
       to_cm->backend_decl = from_cm->backend_decl;
+      to_cm->caf_token = from_cm->caf_token;
       if (from_cm->ts.type == BT_UNION)
         gfc_get_union_type (to_cm->ts.u.derived);
       else if (from_cm->ts.type == BT_DERIVED
@@ -2483,6 +2484,10 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
   gfc_dt_list *dt;
   gfc_namespace *ns;
   tree tmp;
+  bool coarray_flag;
+
+  coarray_flag = flag_coarray == GFC_FCOARRAY_LIB
+                && derived->module && !derived->attr.vtype;
 
   gcc_assert (!derived->attr.pdt_template);
 
@@ -2677,7 +2682,9 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
          field_type = build_pointer_type (tmp);
        }
       else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
-        field_type = c->ts.u.derived->backend_decl;
+       field_type = c->ts.u.derived->backend_decl;
+      else if (c->attr.caf_token)
+       field_type = pvoid_type_node;
       else
        {
          if (c->ts.type == BT_CHARACTER
@@ -2762,19 +2769,6 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
          && !(c->ts.type == BT_DERIVED
               && strcmp (c->name, "_data") == 0))
        GFC_DECL_PTR_ARRAY_P (c->backend_decl) = 1;
-
-      /* Do not add a caf_token field for classes' data components.  */
-      if (codimen && !c->attr.dimension && !c->attr.codimension
-         && (c->attr.allocatable || c->attr.pointer)
-         && c->caf_token == NULL_TREE && strcmp ("_data", c->name) != 0)
-       {
-         char caf_name[GFC_MAX_SYMBOL_LEN];
-         snprintf (caf_name, GFC_MAX_SYMBOL_LEN, "_caf_%s", c->name);
-         c->caf_token = gfc_add_field_to_struct (typenode,
-                                                 get_identifier (caf_name),
-                                                 pvoid_type_node, &chain);
-         TREE_NO_WARNING (c->caf_token) = 1;
-       }
     }
 
   /* Now lay out the derived type, including the fields.  */
@@ -2800,6 +2794,24 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
 
 copy_derived_types:
 
+  for (c = derived->components; c; c = c->next)
+    {
+      /* Do not add a caf_token field for class container components.  */
+      if ((codimen || coarray_flag)
+         && !c->attr.dimension && !c->attr.codimension
+         && (c->attr.allocatable || c->attr.pointer)
+         && !derived->attr.is_class)
+       {
+         char caf_name[GFC_MAX_SYMBOL_LEN];
+         gfc_component *token;
+         snprintf (caf_name, GFC_MAX_SYMBOL_LEN, "_caf_%s", c->name);
+         token = gfc_find_component (derived, caf_name, true, true, NULL);
+         gcc_assert (token);
+         c->caf_token = token->backend_decl;
+         TREE_NO_WARNING (c->caf_token) = 1;
+       }
+    }
+
   for (dt = gfc_derived_types; dt; dt = dt->next)
     gfc_copy_dt_decls_ifequal (derived, dt->derived, false);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 416bcd592eb6c5f3f02fa385293a668e1cb077a4..e4dd14f7e15186b9407a320d4bc89df13dbcccb6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2018-01-01  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/83076
+       * gfortran.dg/coarray_45.f90 : New test.
+
+       PR fortran/83319
+       * gfortran.dg/coarray_46.f90 : New test.
+
 2018-01-01  Jakub Jelinek  <jakub@redhat.com>
 
        PR tree-optimization/83581

diff --git a/gcc/testsuite/gfortran.dg/coarray_45.f90 b/gcc/testsuite/gfortran.dg/coarray_45.f90
new file mode 100644 (file)
index 0000000..8776356
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_45.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -lcaf_single " }
+!
+! Test the fix for PR83076
+!
+module m
+   type t
+      integer, pointer :: z
+   end type
+   type(t) :: ptr
+contains
+   function g(x)
+      type(t) :: x[*]
+      if (associated (x%z, ptr%z)) deallocate (x%z) ! This used to ICE with -fcoarray=lib
+   end
+end module
+
+  use m
+contains
+   function f(x)
+      type(t) :: x[*]
+      if (associated (x%z, ptr%z)) deallocate (x%z)
+   end
+end

diff --git a/gcc/testsuite/gfortran.dg/coarray_46.f90 b/gcc/testsuite/gfortran.dg/coarray_46.f90
new file mode 100644 (file)
index 0000000..273c6e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_46.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+!
+! Test the fix for PR83319
+!
+module foo_module
+  implicit none
+  type foo
+    integer, allocatable :: i(:)
+  end type
+end module
+
+  use foo_module
+  implicit none
+  type(foo), save :: bar[*]
+  allocate(bar%i(1))     ! Used to ICE here.
+end