tree.c (free_lang_data_in_one_sizepos): New inline function.

* tree.c (free_lang_data_in_one_sizepos): New inline function.
	(free_lang_data_in_type): Call it on TYPE_{MIN|MAX}_VALUE of numerical
	types.  Call it on TYPE_SIZE and TYPE_SIZE_UNIT of all types.
	(free_lang_data_in_decl): Call it on DECL_SIZE and DECL_SIZE_UNIT of
	all decls.  Call it on DECL_FIELD_OFFSET of fields.
	(find_decls_types_r): Follow DECL_VALUE_EXPR.
	(iterative_hash_expr) <PLACEHOLDER_EXPR>: New case.

From-SVN: r159039

gcc/ChangeLog

@@ -1,3 +1,13 @@
+2010-05-04  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* tree.c (free_lang_data_in_one_sizepos): New inline function.
+	(free_lang_data_in_type): Call it on TYPE_{MIN|MAX}_VALUE of numerical
+	types.  Call it on TYPE_SIZE and TYPE_SIZE_UNIT of all types.
+	(free_lang_data_in_decl): Call it on DECL_SIZE and DECL_SIZE_UNIT of
+	all decls.  Call it on DECL_FIELD_OFFSET of fields.
+	(find_decls_types_r): Follow DECL_VALUE_EXPR.
+	(iterative_hash_expr) <PLACEHOLDER_EXPR>: New case.
+
 2010-05-04  Martin Jambor  <mjambor@suse.cz>
 
 	* tree-sra.c (build_access_from_expr_1): The first parameter type

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2010-05-04  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/lto1.adb: New test.
+	* gnat.dg/lto1_pkg.ad[sb]: New helper.
+
 2010-05-04  H.J. Lu  <hongjiu.lu@intel.com>
 
 	PR middle-end/43671

gcc/testsuite/gnat.dg/lto1.adb

@@ -0,0 +1,14 @@
+-- PR ada/43106
+-- Testcase by Bill Neven <neven@hitt.nl>
+
+-- { dg-do run }
+-- { dg-options "-O2 -flto" }
+
+with Lto1_Pkg; use Lto1_Pkg;
+
+procedure Lto1 is
+   Radar : Radar_T;
+begin
+   Radar.Sensor_Type := radcmb;
+   Initialize (Radar);
+end;

gcc/testsuite/gnat.dg/lto1_pkg.adb

@@ -0,0 +1,23 @@
+package body Lto1_Pkg is
+
+  procedure Initialize (Radar : in Radar_T) is
+    Antenna1 : Antenna_Type_T;
+    Antenna2 : Antenna_Type_T;
+  begin
+    case Radar.Sensor_Type is
+      when radpr | radssr =>
+        Antenna1 := Radar.Sensor_Type;
+        Antenna2 := Radar.Sensor_Type;
+      when radcmb =>
+        Antenna1 := radpr;
+        Antenna2 := radssr;
+      when others =>
+        Antenna1 := radpr;
+        Antenna2 := radssr;
+    end case;
+    if Antenna1 /= radpr or Antenna2 /= radssr then
+      raise Program_Error;
+    end if;
+  end Initialize;
+
+end Lto1_Pkg;

gcc/testsuite/gnat.dg/lto1_pkg.ads

@@ -0,0 +1,23 @@
+package Lto1_Pkg  is
+
+   type Unsigned_64 is mod 2 ** 64;
+
+   type Associated_Report_T is (miss, radpr, radssr, radcmb);
+
+   -- sensor type : primary, secondary, co-rotating (combined)
+   subtype Sensor_Type_T is Associated_Report_T; -- range radpr .. radcmb;
+   subtype Antenna_Type_T is Sensor_Type_T range radpr .. radssr;
+
+   type Filtering_Level_T is (none, pr_in_clutter, ssr_plots, pr_plots);
+   type Filtering_Levels_T is array (Filtering_Level_T) of boolean;
+
+   type Radar_T is record
+      External_Sensor_ID : Unsigned_64;
+      Dual_Radar_Index : Integer;
+      Compatible_Filtering_Levels : Filtering_Levels_T;
+      Sensor_Type : Sensor_Type_T;
+   end record;
+
+   procedure Initialize (Radar : in Radar_T);
+
+end Lto1_Pkg;

gcc/tree.c

@@ -4174,6 +4174,26 @@ build_type_attribute_variant (tree ttype, tree attribute)
 }
 
 
+/* Reset the expression *EXPR_P, a size or position.
+
+   ??? We could reset all non-constant sizes or positions.  But it's cheap
+   enough to not do so and refrain from adding workarounds to dwarf2out.c.
+
+   We need to reset self-referential sizes or positions because they cannot
+   be gimplified and thus can contain a CALL_EXPR after the gimplification
+   is finished, which will run afoul of LTO streaming.  And they need to be
+   reset to something essentially dummy but not constant, so as to preserve
+   the properties of the object they are attached to.  */
+
+static inline void
+free_lang_data_in_one_sizepos (tree *expr_p)
+{
+  tree expr = *expr_p;
+  if (CONTAINS_PLACEHOLDER_P (expr))
+    *expr_p = build0 (PLACEHOLDER_EXPR, TREE_TYPE (expr));
+}
+
+
 /* Reset all the fields in a binfo node BINFO.  We only keep
    BINFO_VIRTUALS, which is used by gimple_fold_obj_type_ref.  */
 
@@ -4280,8 +4300,19 @@ free_lang_data_in_type (tree type)
       /* For non-aggregate types, clear out the language slot (which
 	 overloads TYPE_BINFO).  */
       TYPE_LANG_SLOT_1 (type) = NULL_TREE;
+
+      if (INTEGRAL_TYPE_P (type)
+	  || SCALAR_FLOAT_TYPE_P (type)
+	  || FIXED_POINT_TYPE_P (type))
+	{
+	  free_lang_data_in_one_sizepos (&TYPE_MIN_VALUE (type));
+	  free_lang_data_in_one_sizepos (&TYPE_MAX_VALUE (type));
+	}
     }
 
+  free_lang_data_in_one_sizepos (&TYPE_SIZE (type));
+  free_lang_data_in_one_sizepos (&TYPE_SIZE_UNIT (type));
+
   if (debug_info_level < DINFO_LEVEL_TERSE
       || (TYPE_CONTEXT (type)
 	  && TREE_CODE (TYPE_CONTEXT (type)) != FUNCTION_DECL
@@ -4417,9 +4448,10 @@ free_lang_data_in_decl (tree decl)
        }
    }
 
- /* ???  We could free non-constant DECL_SIZE, DECL_SIZE_UNIT
-    and DECL_FIELD_OFFSET.  But it's cheap enough to not do
-    that and refrain from adding workarounds to dwarf2out.c  */
+  free_lang_data_in_one_sizepos (&DECL_SIZE (decl));
+  free_lang_data_in_one_sizepos (&DECL_SIZE_UNIT (decl));
+  if (TREE_CODE (decl) == FIELD_DECL)
+    free_lang_data_in_one_sizepos (&DECL_FIELD_OFFSET (decl));
 
  /* DECL_FCONTEXT is only used for debug info generation.  */
  if (TREE_CODE (decl) == FIELD_DECL
@@ -4633,6 +4665,10 @@ find_decls_types_r (tree *tp, int *ws, void *data)
 	  fld_worklist_push (DECL_COMDAT_GROUP (t), fld);
 	}
 
+      if ((TREE_CODE (t) == VAR_DECL || TREE_CODE (t) == PARM_DECL)
+	  && DECL_HAS_VALUE_EXPR_P (t))
+	fld_worklist_push (DECL_VALUE_EXPR (t), fld);
+
       if (TREE_CODE (t) != FIELD_DECL)
 	fld_worklist_push (TREE_CHAIN (t), fld);
       *ws = 0;
@@ -6591,11 +6627,12 @@ iterative_hash_expr (const_tree t, hashval_t val)
       return iterative_hash_expr (TREE_IMAGPART (t), val);
     case VECTOR_CST:
       return iterative_hash_expr (TREE_VECTOR_CST_ELTS (t), val);
-
     case SSA_NAME:
-      /* we can just compare by pointer.  */
+      /* We can just compare by pointer.  */
       return iterative_hash_host_wide_int (SSA_NAME_VERSION (t), val);
-
+    case PLACEHOLDER_EXPR:
+      /* The node itself doesn't matter.  */
+      return val;
     case TREE_LIST:
       /* A list of expressions, for a CALL_EXPR or as the elements of a
 	 VECTOR_CST.  */