re PR middle-end/89621 (ICE with allocatable character and openmp)

PR middle-end/89621
	* tree-inline.h (struct copy_body_data): Add
	dont_remap_vla_if_no_change flag.
	* tree-inline.c (remap_type_3, remap_type_2): New functions.
	(remap_type): Don't remap vla types if id->dont_remap_vla_if_no_change
	and remap_type_2 returns false.
	* omp-low.c (new_omp_context): Set ctx->cb.dont_remap_vla_if_no_change.
	Move ctx->cb.adjust_array_error_bounds setting to the outermost ctx
	only from where it is copied to nested contexts.

	* gfortran.dg/gomp/pr89621.f90: New test.

From-SVN: r270009

gcc/ChangeLog

@@ -1,3 +1,15 @@
+2019-03-28  Jakub Jelinek  <jakub@redhat.com>
+
+	PR middle-end/89621
+	* tree-inline.h (struct copy_body_data): Add
+	dont_remap_vla_if_no_change flag.
+	* tree-inline.c (remap_type_3, remap_type_2): New functions.
+	(remap_type): Don't remap vla types if id->dont_remap_vla_if_no_change
+	and remap_type_2 returns false.
+	* omp-low.c (new_omp_context): Set ctx->cb.dont_remap_vla_if_no_change.
+	Move ctx->cb.adjust_array_error_bounds setting to the outermost ctx
+	only from where it is copied to nested contexts.
+
 2019-03-28  Uroš Bizjak  <ubizjak@gmail.com>
 
 	PR target/89865

gcc/omp-low.c

@@ -868,11 +868,12 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
       ctx->cb.copy_decl = omp_copy_decl;
       ctx->cb.eh_lp_nr = 0;
       ctx->cb.transform_call_graph_edges = CB_CGE_MOVE;
+      ctx->cb.adjust_array_error_bounds = true;
+      ctx->cb.dont_remap_vla_if_no_change = true;
       ctx->depth = 1;
     }
 
   ctx->cb.decl_map = new hash_map<tree, tree>;
-  ctx->cb.adjust_array_error_bounds = true;
 
   return ctx;
 }

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2019-03-28  Jakub Jelinek  <jakub@redhat.com>
+
+	PR middle-end/89621
+	* gfortran.dg/gomp/pr89621.f90: New test.
+
 2019-03-28  Martin Sebor  <msebor@redhat.com>
 
 	PR c++/66548

gcc/testsuite/gfortran.dg/gomp/pr89621.f90

@@ -0,0 +1,18 @@
+! PR middle-end/89621
+! { dg-do compile }
+
+subroutine sub(str)
+  character(*), intent(in) :: str
+end subroutine sub
+
+program pr89621
+  implicit none
+  integer i
+  character(len=:), allocatable :: str
+  str = "test"
+  !$omp parallel do
+  do i = 1, 10
+    call sub(str)
+  enddo
+  !$omp end parallel do
+end program pr89621

gcc/tree-inline.c

@@ -598,6 +598,92 @@ remap_type_1 (tree type, copy_body_data *id)
   return new_tree;
 }
 
+/* Helper function for remap_type_2, called through walk_tree.  */
+
+static tree
+remap_type_3 (tree *tp, int *walk_subtrees, void *data)
+{
+  copy_body_data *id = (copy_body_data *) data;
+
+  if (TYPE_P (*tp))
+    *walk_subtrees = 0;
+
+  else if (DECL_P (*tp) && remap_decl (*tp, id) != *tp)
+    return *tp;
+
+  return NULL_TREE;
+}
+
+/* Return true if TYPE needs to be remapped because remap_decl on any
+   needed embedded decl returns something other than that decl.  */
+
+static bool
+remap_type_2 (tree type, copy_body_data *id)
+{
+  tree t;
+
+#define RETURN_TRUE_IF_VAR(T) \
+  do								\
+    {								\
+      tree _t = (T);						\
+      if (_t)							\
+	{							\
+	  if (DECL_P (_t) && remap_decl (_t, id) != _t)		\
+	    return true;					\
+	  if (!TYPE_SIZES_GIMPLIFIED (type)			\
+	      && walk_tree (&_t, remap_type_3, id, NULL))	\
+	    return true;					\
+	}							\
+    }								\
+  while (0)
+
+  switch (TREE_CODE (type))
+    {
+    case POINTER_TYPE:
+    case REFERENCE_TYPE:
+    case FUNCTION_TYPE:
+    case METHOD_TYPE:
+      return remap_type_2 (TREE_TYPE (type), id);
+
+    case INTEGER_TYPE:
+    case REAL_TYPE:
+    case FIXED_POINT_TYPE:
+    case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
+      RETURN_TRUE_IF_VAR (TYPE_MIN_VALUE (type));
+      RETURN_TRUE_IF_VAR (TYPE_MAX_VALUE (type));
+      return false;
+
+    case ARRAY_TYPE:
+      if (remap_type_2 (TREE_TYPE (type), id)
+	  || (TYPE_DOMAIN (type) && remap_type_2 (TYPE_DOMAIN (type), id)))
+	return true;
+      break;
+
+    case RECORD_TYPE:
+    case UNION_TYPE:
+    case QUAL_UNION_TYPE:
+      for (t = TYPE_FIELDS (type); t; t = DECL_CHAIN (t))
+	if (TREE_CODE (t) == FIELD_DECL)
+	  {
+	    RETURN_TRUE_IF_VAR (DECL_FIELD_OFFSET (t));
+	    RETURN_TRUE_IF_VAR (DECL_SIZE (t));
+	    RETURN_TRUE_IF_VAR (DECL_SIZE_UNIT (t));
+	    if (TREE_CODE (type) == QUAL_UNION_TYPE)
+	      RETURN_TRUE_IF_VAR (DECL_QUALIFIER (t));
+	  }
+      break;
+
+    default:
+      return false;
+    }
+
+  RETURN_TRUE_IF_VAR (TYPE_SIZE (type));
+  RETURN_TRUE_IF_VAR (TYPE_SIZE_UNIT (type));
+  return false;
+#undef RETURN_TRUE_IF_VAR
+}
+
 tree
 remap_type (tree type, copy_body_data *id)
 {
@@ -613,7 +699,10 @@ remap_type (tree type, copy_body_data *id)
     return *node;
 
   /* The type only needs remapping if it's variably modified.  */
-  if (! variably_modified_type_p (type, id->src_fn))
+  if (! variably_modified_type_p (type, id->src_fn)
+      /* Don't remap if copy_decl method doesn't always return a new
+	 decl and for all embedded decls returns the passed in decl.  */
+      || (id->dont_remap_vla_if_no_change && !remap_type_2 (type, id)))
     {
       insert_decl_map (id, type, type);
       return type;

gcc/tree-inline.h

@@ -123,6 +123,13 @@ struct copy_body_data
      an uninitialized VAR_DECL temporary.  */
   bool adjust_array_error_bounds;
 
+  /* Usually copy_decl callback always creates new decls, in that case
+     we want to remap all variably_modified_type_p types.  If this flag
+     is set, remap_type will do further checks to see if remap_decl
+     of any decls mentioned in the type will remap to anything but itself
+     and only in that case will actually remap the type.  */
+  bool dont_remap_vla_if_no_change;
+
   /* A function to be called when duplicating BLOCK nodes.  */
   void (*transform_lang_insert_block) (tree);