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

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

gcc/fortran/ChangeLog

+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

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.  */

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)

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

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/coarray_45.f90

+! { 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

gcc/testsuite/gfortran.dg/coarray_46.f90

+! { 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