re PR lto/41715 (VIEW_CONVERT_EXPR use for mismatched prevailing decl replacement doesn't work)

2009-10-16  Richard Guenther  <rguenther@suse.de>

	PR lto/41715
	* lto-streamer-in.c (lto_input_tree_ref): Revert last change.
	(maybe_fixup_handled_component): New function.
	(input_gimple_stmt): Fixup mismatched decl replacements.

	lto/
	* lto.c (lto_fixup_tree): Revert last change.

	* gfortran.dg/lto/20091015-1_0.f: New testcase.
	* gfortran.dg/lto/20091015-1_1.f: Likewise.
	* gfortran.dg/lto/20091015-1_2.f: Likewise.

From-SVN: r152903

gcc/ChangeLog

@@ -1,3 +1,10 @@
+2009-10-16  Richard Guenther  <rguenther@suse.de>
+
+	PR lto/41715
+	* lto-streamer-in.c (lto_input_tree_ref): Revert last change.
+	(maybe_fixup_handled_component): New function.
+	(input_gimple_stmt): Fixup mismatched decl replacements.
+
 2009-10-16  Richard Guenther  <rguenther@suse.de>
 
 	PR lto/41713

gcc/lto-streamer-in.c

@@ -353,16 +353,7 @@ lto_input_tree_ref (struct lto_input_block *ib, struct data_in *data_in,
       ix_u = lto_input_uleb128 (ib);
       result = lto_file_decl_data_get_var_decl (data_in->file_data, ix_u);
       if (tag == LTO_global_decl_ref)
-	{
+	varpool_mark_needed_node (varpool_node (result));
-	  if (TREE_CODE (result) == VIEW_CONVERT_EXPR)
-	    {
-	      tree decl = TREE_OPERAND (result, 0);
-	      varpool_mark_needed_node (varpool_node (decl));
-	      result = build1 (VIEW_CONVERT_EXPR, TREE_TYPE (result), decl);
-	    }
-	  else
-	    varpool_mark_needed_node (varpool_node (result));
-	}
       break;
 
     default:
@@ -877,6 +868,128 @@ input_ssa_names (struct lto_input_block *ib, struct data_in *data_in,
 }
 
 
+/* Fixup the reference tree OP for replaced VAR_DECLs with mismatched
+   types.  */
+
+static void
+maybe_fixup_handled_component (tree op)
+{
+  tree decl_type;
+  tree wanted_type;
+
+  while (handled_component_p (TREE_OPERAND (op, 0)))
+    op = TREE_OPERAND (op, 0);
+  if (TREE_CODE (TREE_OPERAND (op, 0)) != VAR_DECL)
+    return;
+
+  decl_type = TREE_TYPE (TREE_OPERAND (op, 0));
+
+  switch (TREE_CODE (op))
+    {
+    case COMPONENT_REF:
+      /* The DECL_CONTEXT of the field-decl is the record type we look for.  */
+      wanted_type = DECL_CONTEXT (TREE_OPERAND (op, 1));
+      break;
+
+    case ARRAY_REF:
+      if (TREE_CODE (decl_type) == ARRAY_TYPE
+	  && (TREE_TYPE (decl_type) == TREE_TYPE (op)
+	      || useless_type_conversion_p (TREE_TYPE (op),
+					    TREE_TYPE (decl_type))))
+	return;
+      /* An unknown size array type should be ok.  But we do not
+         lower the lower bound in all cases - ugh.  */
+      wanted_type = build_array_type (TREE_TYPE (op), NULL_TREE);
+      break;
+
+    case ARRAY_RANGE_REF:
+      if (TREE_CODE (decl_type) == ARRAY_TYPE
+	  && (TREE_TYPE (decl_type) == TREE_TYPE (TREE_TYPE (op))
+	      || useless_type_conversion_p (TREE_TYPE (TREE_TYPE (op)),
+					    TREE_TYPE (decl_type))))
+	return;
+      /* An unknown size array type should be ok.  But we do not
+         lower the lower bound in all cases - ugh.  */
+      wanted_type = build_array_type (TREE_TYPE (TREE_TYPE (op)), NULL_TREE);
+      break;
+
+    case BIT_FIELD_REF:
+    case VIEW_CONVERT_EXPR:
+      /* Very nice - nothing to do.  */
+      return;
+
+    case REALPART_EXPR:
+    case IMAGPART_EXPR:
+      if (TREE_CODE (decl_type) == COMPLEX_TYPE
+	  && (TREE_TYPE (decl_type) == TREE_TYPE (op)
+	      || useless_type_conversion_p (TREE_TYPE (op),
+					    TREE_TYPE (decl_type))))
+	return;
+      wanted_type = build_complex_type (TREE_TYPE (op));
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  if (!useless_type_conversion_p (wanted_type, decl_type))
+    TREE_OPERAND (op, 0) = build1 (VIEW_CONVERT_EXPR, wanted_type,
+				   TREE_OPERAND (op, 0));
+}
+
+/* Fixup reference tree operands for substituted prevailing decls
+   with mismatched types in STMT.  */
+
+static void
+maybe_fixup_decls (gimple stmt)
+{
+  /* We have to fixup replaced decls here in case there were
+     inter-TU type mismatches.  Catch the most common cases
+     for now - this way we'll get testcases for the rest as
+     the type verifier will complain.  */
+  if (gimple_assign_single_p (stmt))
+    {
+      tree lhs = gimple_assign_lhs (stmt);
+      tree rhs = gimple_assign_rhs1 (stmt);
+
+      /* First catch loads and aggregate copies by adjusting the rhs.  */
+      if (TREE_CODE (rhs) == VAR_DECL)
+	{
+	  if (!useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs)))
+	    gimple_assign_set_rhs1 (stmt, build1 (VIEW_CONVERT_EXPR,
+						  TREE_TYPE (lhs), rhs));
+	}
+      else if (handled_component_p (rhs))
+	maybe_fixup_handled_component (rhs);
+      /* Then catch scalar stores.  */
+      else if (TREE_CODE (lhs) == VAR_DECL)
+	{
+	  if (!useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs)))
+	    gimple_assign_set_lhs (stmt, build1 (VIEW_CONVERT_EXPR,
+						 TREE_TYPE (rhs), lhs));
+	}
+      else if (handled_component_p (lhs))
+	maybe_fixup_handled_component (lhs);
+    }
+  else if (is_gimple_call (stmt))
+    {
+      tree lhs = gimple_call_lhs (stmt);
+
+      if (lhs && TREE_CODE (lhs) == VAR_DECL)
+	{
+	  if (!useless_type_conversion_p (TREE_TYPE (lhs),
+					  gimple_call_return_type (stmt)))
+	    gimple_call_set_lhs (stmt, build1 (VIEW_CONVERT_EXPR,
+					       gimple_call_return_type (stmt),
+					       lhs));
+	}
+      else if (lhs && handled_component_p (lhs))
+	maybe_fixup_handled_component (lhs);
+
+      /* Arguments, especially for varargs functions will be funny...  */
+    }
+}
+
 /* Read a statement with tag TAG in function FN from block IB using
    descriptors in DATA_IN.  */
 
@@ -983,6 +1096,10 @@ input_gimple_stmt (struct lto_input_block *ib, struct data_in *data_in,
 	}
     }
 
+  /* Fixup reference tree operands for substituted prevailing decls
+     with mismatched types.  */
+  maybe_fixup_decls (stmt);
+
   /* Mark the statement modified so its operand vectors can be filled in.  */
   gimple_set_modified (stmt, true);
 

gcc/lto/ChangeLog

@@ -1,3 +1,8 @@
+2009-10-16  Richard Guenther  <rguenther@suse.de>
+
+	PR lto/41715
+	* lto.c (lto_fixup_tree): Revert last change.
+
 2009-10-14  Richard Guenther  <rguenther@suse.de>
 
 	* lto.c (lto_fixup_tree): In case the prevailing decl is not

gcc/lto/lto.c

@@ -1530,18 +1530,10 @@ lto_fixup_tree (tree *tp, int *walk_subtrees, void *data)
 
 	  pointer_set_insert (fixup_data->free_list, t);
 
-	  /* Replace the decl.  If it is a not compatible VAR_DECL wrap
-	     it inside a VIEW_CONVERT_EXPR.  */
-	  if (TREE_CODE (*tp) == VAR_DECL
-	      && !useless_type_conversion_p (TREE_TYPE (*tp),
-					     TREE_TYPE (prevailing)))
-	    *tp = build1 (VIEW_CONVERT_EXPR, TREE_TYPE (*tp), prevailing);
-	  else
-	    *tp = prevailing;
-
 	   /* Also replace t with prevailing defintion.  We don't want to
 	      insert the other defintion in the seen set as we want to
 	      replace all instances of it.  */
+	  *tp = prevailing;
 	  t = prevailing;
 	}
     }

gcc/testsuite/ChangeLog

@@ -1,3 +1,10 @@
+2009-10-16  Richard Guenther  <rguenther@suse.de>
+
+	PR lto/41715
+	* gfortran.dg/lto/20091015-1_0.f: New testcase.
+	* gfortran.dg/lto/20091015-1_1.f: Likewise.
+	* gfortran.dg/lto/20091015-1_2.f: Likewise.
+
 2009-10-16  Richard Guenther  <rguenther@suse.de>
 
 	PR lto/41713

gcc/testsuite/gfortran.dg/lto/20091015-1_0.f

@@ -0,0 +1,8 @@
+! { dg-lto-do link }
+! We expect some warnings about mismatched symbol types
+! { dg-extra-ld-options "-w" }
+
+      subroutine dalie6s(iqmod6,nz,wx,cor6d)
+      common/dascr/iscrda(100),rscrri(100),iscrri(100),idao
+      call daall(iscrda,100,'$$IS      ',no,nv)
+      end

gcc/testsuite/gfortran.dg/lto/20091015-1_1.f

@@ -0,0 +1,4 @@
+      SUBROUTINE DAALL(IC,L,CCC,NO,NV)
+      COMMON /main1/ eps
+      END
+

gcc/testsuite/gfortran.dg/lto/20091015-1_2.f

@@ -0,0 +1,5 @@
+      program test
+      common/main1/ eps(2)
+      dimension cor6d(2,2)
+      call dalie6s(iqmod6,1,wx,cor6d)
+      end