re PR ada/19900 (ACATS c391002 c432002 ICE categorize_ctor_elements_1)

2005-03-08  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	PR ada/19900

	* exp_pakd.adb (Create_Packed_Array_Type): Do not set
	Must_Be_Byte_Aligned for cases where we do not need to use a
	System.Pack_nn unit.

	* exp_ch6.adb (Expand_Call): Call Expand_Actuals for functions as well
	as procedures.
	Needed now that we do some processing for IN parameters as well. This
	may well fix some unrelated errors.
	(Expand_Call): Handle case of unaligned objects (in particular those
	that come from packed arrays).
	(Expand_Inlined_Call): If the subprogram is a renaming as body, and the
	renamed entity is an inherited operation, re-expand the call using the
	original operation, which is the one to call.
	Detect attempt to inline parameterless recursive subprogram.
	(Represented_As_Scalar): Fix to work properly with private types
	(Is_Possibly_Unaligned_Object): Major rewrite to get a much more
	accurate estimate. Yields True in far fewer cases than before,
	improving the quality of code that depends on this test.
	(Remove_Side_Effects): Properly test for Expansion_Delayed and handle
	case when it's inside an N_Qualified_Expression.

	* exp_util.adb (Kill_Dead_Code): For a package declaration, iterate
	over both visible and private declarations to remove them from tree,
	and mark subprograms declared in package as eliminated, to prevent
	spurious use in subsequent compilation of generic units in the context.

	* exp_util.ads: Minor cleanup in variable names

	* sem_eval.ads, sem_eval.adb: Minor reformatting
	(Compile_Time_Known_Bounds): New function

From-SVN: r96493

gcc/ada/exp_pakd.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1219,9 +1219,13 @@ package body Exp_Pakd is
 
          --  Currently the code in this unit requires that packed arrays
          --  represented by non-modular arrays of bytes be on a byte
-         --  boundary.
+         --  boundary for bit sizes handled by System.Pack_nn units.
+         --  That's because these units assume the array being accessed
+         --  starts on a byte boundary.
 
-         Set_Must_Be_On_Byte_Boundary (Typ);
+         if Get_Id (UI_To_Int (Csize)) /= RE_Null then
+            Set_Must_Be_On_Byte_Boundary (Typ);
+         end if;
       end if;
    end Create_Packed_Array_Type;
 

gcc/ada/exp_util.ads

@@ -417,7 +417,7 @@ package Exp_Util is
    --  nodes. False otherwise. True for an empty list. It is an error
    --  to call this routine with No_List as the argument.
 
-   function Is_Ref_To_Bit_Packed_Array (P : Node_Id) return Boolean;
+   function Is_Ref_To_Bit_Packed_Array (N : Node_Id) return Boolean;
    --  Determine whether the node P is a reference to a bit packed
    --  array, i.e. whether the designated object is a component of
    --  a bit packed array, or a subcomponent of such a component.
@@ -425,18 +425,18 @@ package Exp_Util is
    --  to Force_Evaluation, and True is returned. Otherwise False
    --  is returned, and P is not affected.
 
-   function Is_Ref_To_Bit_Packed_Slice (P : Node_Id) return Boolean;
+   function Is_Ref_To_Bit_Packed_Slice (N : Node_Id) return Boolean;
    --  Determine whether the node P is a reference to a bit packed
    --  slice, i.e. whether the designated object is bit packed slice
    --  or a component of a bit packed slice. Return True if so.
 
-   function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean;
+   function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean;
    --  Determine whether the node P is a slice of an array where the slice
    --  result may cause alignment problems because it has an alignment that
    --  is not compatible with the type. Return True if so.
 
-   function Is_Possibly_Unaligned_Object (P : Node_Id) return Boolean;
-   --  Node P is an object reference. This function returns True if it
+   function Is_Possibly_Unaligned_Object (N : Node_Id) return Boolean;
+   --  Node N is an object reference. This function returns True if it
    --  is possible that the object may not be aligned according to the
    --  normal default alignment requirement for its type (e.g. if it
    --  appears in a packed record, or as part of a component that has
@@ -511,6 +511,11 @@ package Exp_Util is
    --  call to Remove_Side_Effects, it is safe to call New_Copy_Tree to
    --  obtain a copy of the resulting expression.
 
+   function Represented_As_Scalar (T : Entity_Id) return Boolean;
+   --  Returns True iff the implementation of this type in code generation
+   --  terms is scalar. This is true for scalars in the Ada sense, and for
+   --  packed arrays which are represented by a scalar (modular) type.
+
    function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
    --  Given the node for an N_Unchecked_Type_Conversion, return True
    --  if this is an unchecked conversion that Gigi can handle directly.

gcc/ada/sem_eval.adb

@@ -377,8 +377,7 @@ package body Sem_Eval is
 
    function Compile_Time_Compare
      (L, R : Node_Id;
-      Rec  : Boolean := False)
-      return Compare_Result
+      Rec  : Boolean := False) return Compare_Result
    is
       Ltyp : constant Entity_Id := Etype (L);
       Rtyp : constant Entity_Id := Etype (R);
@@ -795,6 +794,34 @@ package body Sem_Eval is
       end if;
    end Compile_Time_Compare;
 
+   -------------------------------
+   -- Compile_Time_Known_Bounds --
+   -------------------------------
+
+   function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean is
+      Indx : Node_Id;
+      Typ  : Entity_Id;
+
+   begin
+      if not Is_Array_Type (T) then
+         return False;
+      end if;
+
+      Indx := First_Index (T);
+      while Present (Indx) loop
+         Typ := Underlying_Type (Etype (Indx));
+         if not Compile_Time_Known_Value (Type_Low_Bound (Typ)) then
+            return False;
+         elsif not Compile_Time_Known_Value (Type_High_Bound (Typ)) then
+            return False;
+         else
+            Next_Index (Indx);
+         end if;
+      end loop;
+
+      return True;
+   end Compile_Time_Known_Bounds;
+
    ------------------------------
    -- Compile_Time_Known_Value --
    ------------------------------
@@ -3116,8 +3143,7 @@ package body Sem_Eval is
    function In_Subrange_Of
      (T1        : Entity_Id;
       T2        : Entity_Id;
-      Fixed_Int : Boolean := False)
-      return      Boolean
+      Fixed_Int : Boolean := False) return Boolean
    is
       L1 : Node_Id;
       H1 : Node_Id;
@@ -3219,8 +3245,7 @@ package body Sem_Eval is
      (N         : Node_Id;
       Typ       : Entity_Id;
       Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False)
-      return      Boolean
+      Int_Real  : Boolean := False) return Boolean
    is
       Val  : Uint;
       Valr : Ureal;
@@ -3400,8 +3425,7 @@ package body Sem_Eval is
      (N         : Node_Id;
       Typ       : Entity_Id;
       Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False)
-      return      Boolean
+      Int_Real  : Boolean := False) return Boolean
    is
       Val  : Uint;
       Valr : Ureal;
@@ -3691,9 +3715,8 @@ package body Sem_Eval is
    ------------------------------------
 
    function Subtypes_Statically_Compatible
-     (T1   : Entity_Id;
-      T2   : Entity_Id)
-      return Boolean
+     (T1 : Entity_Id;
+      T2 : Entity_Id) return Boolean
    is
    begin
       if Is_Scalar_Type (T1) then

gcc/ada/sem_eval.ads

@@ -137,8 +137,7 @@ package Sem_Eval is
    subtype Compare_LE is Compare_Result range LT .. EQ;
    function Compile_Time_Compare
      (L, R : Node_Id;
-      Rec  : Boolean := False)
-      return Compare_Result;
+      Rec  : Boolean := False) return Compare_Result;
    --  Given two expression nodes, finds out whether it can be determined
    --  at compile time how the runtime values will compare. An Unknown
    --  result means that the result of a comparison cannot be determined at
@@ -194,9 +193,8 @@ package Sem_Eval is
    --  range is not static, or because one or the other bound raises CE).
 
    function Subtypes_Statically_Compatible
-     (T1   : Entity_Id;
-      T2   : Entity_Id)
-      return Boolean;
+     (T1 : Entity_Id;
+      T2 : Entity_Id) return Boolean;
    --  Returns true if the subtypes are unconstrained or the constraint on
    --  on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
    --  Otherwise returns false.
@@ -222,6 +220,11 @@ package Sem_Eval is
    --  whose constituent expressions are either compile time known values
    --  or compile time known aggregates.
 
+   function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean;
+   --  If T is an array whose index bounds are all known at compile time,
+   --  then True is returned, if T is not an array, or one or more of its
+   --  index bounds is not known at compile time, then False is returned.
+
    function Expr_Value (N : Node_Id) return Uint;
    --  Returns the folded value of the expression N. This function is called
    --  in instances where it has already been determined that the expression
@@ -330,8 +333,7 @@ package Sem_Eval is
      (N         : Node_Id;
       Typ       : Entity_Id;
       Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False)
-      return      Boolean;
+      Int_Real  : Boolean := False) return Boolean;
    --  Returns True if it can be guaranteed at compile time that expression
    --  N is known to be in range of the subtype Typ. If the values of N or
    --  of either bouds of Type are unknown at compile time, False will
@@ -353,8 +355,7 @@ package Sem_Eval is
      (N         : Node_Id;
       Typ       : Entity_Id;
       Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False)
-      return      Boolean;
+      Int_Real  : Boolean := False) return Boolean;
    --  Returns True if it can be guaranteed at compile time that expression
    --  N is known to be out of range of the subtype Typ.  True is returned
    --  if Typ is a scalar type, at least one of whose bounds is known at
@@ -367,8 +368,7 @@ package Sem_Eval is
    function In_Subrange_Of
      (T1        : Entity_Id;
       T2        : Entity_Id;
-      Fixed_Int : Boolean := False)
-      return      Boolean;
+      Fixed_Int : Boolean := False) return Boolean;
    --  Returns True if it can be guaranteed at compile time that the range
    --  of values for scalar type T1 are always in the range of scalar type
    --  T2.  A result of False does not mean that T1 is not in T2's subrange,