2008-04-08 Hristian Kirtchev <kirtchev@adacore.com>

	    Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* exp_ch9.ads, exp_ch9.adb (Build_Protected_Entry,
	Build_Unprotected_Subprogram_Body): Generate debug info for
	declarations related to the handling of private data in task and
	protected types.
	(Debug_Private_Data_Declarations): New subprogram.
	(Install_Private_Data_Declarations): Remove all debug info flagging.
	This is now done by Debug_Private_Data_Declarations at the correct
	stage of expansion.
	(Build_Simple_Entry_Call): If the task name is a function call, expand
	the prefix into an object declaration, and make the surrounding block a
	task master.
	(Build_Master_Entity): An internal block is a master if it wraps a call.
	Code reformatting, update comments. Code clean up.
	(Make_Task_Create_Call): Use 'Unrestricted_Access instead of 'Address.
	(Replicate_Entry_Formals): If the formal is an access parameter or
	anonymous access to subprogram, copy the original tree to create new
	entities for the formals of the subprogram.
	(Expand_N_Task_Type_Declaration): Create a Relative_Deadline variable
	for tasks to store the value passed using pragma Relative_Deadline.
	(Make_Task_Create_Call): Add the Relative_Deadline argument to the
	run-time call to create a task.
	(Build_Wrapper_Spec): If the controlling argument of the interface
	operation is an access parameter with a non-null indicator, use the
	non-null indicator on the wrapper.

	* sem_ch9.adb (Analyze_Protected_Type): Only retrieve the full view when
	present, which it may not be in the case where the type entity is an
	incomplete view brought in by a limited with.
	(Analyze_Task_Type): Only retrieve the full view when present, which it
	may not be in the case where the type entity is an incomplete view
	brought in by a limited with.
	(Analyze_Protected_Definition): Set Is_Frozen on all itypes generated for
	private components of a protected type, to prevent the generation of
	freeze nodes for which there is no proper scope of elaboration.

	* exp_util.ads, exp_util.adb (Remove_Side_Effects): If the expression is
	a function call that returns a task, expand into a declaration to invoke
	the build_in_place machinery.
	(Find_Protection_Object): New routine.
	(Remove_Side_Effects): Also make a copy of the value
	for attributes whose result is of an elementary type.
	(Silly_Boolean_Array_Not_Test): New procedure
	(Silly_Boolean_Array_Xor_Test): New procedure
	(Is_Volatile_Reference): New function
	(Remove_Side_Effects): Use Is_Volatile_Reference
	(Possible_Bit_Aligned_Component): Handle slice case properly

	* exp_pakd.adb (Expand_Packed_Not): Move silly true/true or false/false
	case test to Exp_Util
	(Expand_Packed_Xor): Move silly true/true case test to Exp_Util



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134030 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 8 insertions, 70 deletions

diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index 21a78ac80a4..8f191be3a36 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -1092,7 +1092,7 @@ package body Exp_Pakd is
          --  discriminants, so we treat it as a default/per-object expression.
 
          Set_Parent (Len_Expr, Typ);
-         Analyze_Per_Use_Expression (Len_Expr, Standard_Long_Long_Integer);
+         Preanalyze_Spec_Expression (Len_Expr, Standard_Long_Long_Integer);
 
          --  Use a modular type if possible. We can do this if we have
          --  static bounds, and the length is small enough, and the length
@@ -1774,47 +1774,11 @@ package body Exp_Pakd is
       Ltyp := Etype (L);
       Rtyp := Etype (R);
 
-      --  First an odd and silly test. We explicitly check for the XOR
-      --  case where the component type is True .. True, since this will
-      --  raise constraint error. A special check is required since CE
-      --  will not be required other wise (cf Expand_Packed_Not).
-
-      --  No such check is required for AND and OR, since for both these
-      --  cases False op False = False, and True op True = True.
+      --  Deeal with silly case of XOR where the subcomponent has a range
+      --  True .. True where an exception must be raised.
 
       if Nkind (N) = N_Op_Xor then
-         declare
-            CT : constant Entity_Id := Component_Type (Rtyp);
-            BT : constant Entity_Id := Base_Type (CT);
-
-         begin
-            Insert_Action (N,
-              Make_Raise_Constraint_Error (Loc,
-                Condition =>
-                  Make_Op_And (Loc,
-                    Left_Opnd =>
-                      Make_Op_Eq (Loc,
-                        Left_Opnd =>
-                          Make_Attribute_Reference (Loc,
-                            Prefix         => New_Occurrence_Of (CT, Loc),
-                            Attribute_Name => Name_First),
-
-                        Right_Opnd =>
-                          Convert_To (BT,
-                            New_Occurrence_Of (Standard_True, Loc))),
-
-                    Right_Opnd =>
-                      Make_Op_Eq (Loc,
-                        Left_Opnd =>
-                          Make_Attribute_Reference (Loc,
-                            Prefix         => New_Occurrence_Of (CT, Loc),
-                            Attribute_Name => Name_Last),
-
-                        Right_Opnd =>
-                          Convert_To (BT,
-                            New_Occurrence_Of (Standard_True, Loc)))),
-                Reason => CE_Range_Check_Failed));
-         end;
+         Silly_Boolean_Array_Xor_Test (N, Rtyp);
       end if;
 
       --  Now that that silliness is taken care of, get packed array type
@@ -2186,37 +2150,11 @@ package body Exp_Pakd is
       Convert_To_Actual_Subtype (Opnd);
       Rtyp := Etype (Opnd);
 
-      --  First an odd and silly test. We explicitly check for the case
-      --  where the 'First of the component type is equal to the 'Last of
-      --  this component type, and if this is the case, we make sure that
-      --  constraint error is raised. The reason is that the NOT is bound
-      --  to cause CE in this case, and we will not otherwise catch it.
+      --  Deal with silly False..False and True..True subtype case
 
-      --  Believe it or not, this was reported as a bug. Note that nearly
-      --  always, the test will evaluate statically to False, so the code
-      --  will be statically removed, and no extra overhead caused.
+      Silly_Boolean_Array_Not_Test (N, Rtyp);
 
-      declare
-         CT : constant Entity_Id := Component_Type (Rtyp);
-
-      begin
-         Insert_Action (N,
-           Make_Raise_Constraint_Error (Loc,
-             Condition =>
-               Make_Op_Eq (Loc,
-                 Left_Opnd =>
-                   Make_Attribute_Reference (Loc,
-                     Prefix         => New_Occurrence_Of (CT, Loc),
-                     Attribute_Name => Name_First),
-
-                 Right_Opnd =>
-                   Make_Attribute_Reference (Loc,
-                     Prefix         => New_Occurrence_Of (CT, Loc),
-                     Attribute_Name => Name_Last)),
-             Reason => CE_Range_Check_Failed));
-      end;
-
-      --  Now that that silliness is taken care of, get packed array type
+      --  Now that the silliness is taken care of, get packed array type
 
       Convert_To_PAT_Type (Opnd);
       PAT := Etype (Opnd);