2003-11-26 Thomas Quinot <quinot@act-europe.fr>

	* g-socket.ads, g-socket.adb:
	Clarify documentation of function Stream. Introduce a Free procedure
	to release the returned Stream once it becomes unused.

	* 5asystem.ads: For Alpha Tru64, enable ZCX by default.

2003-11-26  Arnaud Charlet  <charlet@act-europe.fr>

	(Cond_Timed_Wait): Introduce new constant Time_Out_Max,
	since NT 4 cannot handle timeout values that are too large,
	e.g. DWORD'Last - 1.

2003-11-26  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch4.adb:
	(Expand_N_Slice): Recognize all cases of slices that appear as actuals
	in procedure calls and whose expansion must be deferred.

	* exp_ch6.adb (Add_Call_By_Copy_Node): Remove previous fix. Proper fix
	is in exp_ch4.

	* sem_ch3.adb:
	(Build_Derived_Array_Type): Create operator for unconstrained type
	if ancestor is unconstrained.

2003-11-26  Vincent Celier  <celier@gnat.com>

	* make.adb (Project_Object_Directory): New global variable
	(Change_To_Object_Directory): New procedure
	(Collect_Arguments_And_Compile): Call Change_To_Object_Directory instead
	of Change_Dir directly. Do not change working directory to object
	directory of main project after each compilation.
	(Gnatmake): Use Change_To_Object_Directory instead of Change_Dir
	directly.
	Change to object directory of main project before binding step.
	(Initialize): Initialize Project_Object_Directory to No_Project

	* mlib-prj.adb:
	(Build_Library): Take into account Builder'Default_Switches ("Ada") when
	binding a Stand-Alone Library.

	* output.adb: Update Copyright notice
	(Write_Char): Output buffer when full

2003-11-26  Robert Dewar  <dewar@gnat.com>

	* sem_ch13.adb: (Check_Size): Reset size if size is too small

	* sem_ch13.ads:
	(Check_Size): Fix documentation to include bit-packed array case

	* sem_res.adb: Implement restriction No_Direct_Boolean_Operators

	* s-rident.ads: Put No_Direct_Boolean_Operators in proper order

	* s-rident.ads: Add new restriction No_Direct_Boolean_Operators


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

1 files changed, 49 insertions, 16 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 85de43395e3..86ff9947620 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5333,11 +5333,36 @@ package body Exp_Ch4 is
       Pfx  : constant Node_Id    := Prefix (N);
       Ptp  : Entity_Id           := Etype (Pfx);
 
+      function Is_Procedure_Actual (N : Node_Id) return Boolean;
+      --  Check whether context is a procedure call, in which case
+      --  expansion of a bit-packed slice is deferred until the call
+      --  itself is expanded.
+
       procedure Make_Temporary;
       --  Create a named variable for the value of the slice, in
       --  cases where the back-end cannot handle it properly, e.g.
       --  when packed types or unaligned slices are involved.
 
+      -------------------------
+      -- Is_Procedure_Actual --
+      -------------------------
+
+      function Is_Procedure_Actual (N : Node_Id) return Boolean is
+         Par : Node_Id := Parent (N);
+      begin
+         while Present (Par)
+           and then Nkind (Par) not in N_Statement_Other_Than_Procedure_Call
+         loop
+            if Nkind (Par) = N_Procedure_Call_Statement then
+               return True;
+            else
+               Par := Parent (Par);
+            end if;
+         end loop;
+
+         return False;
+      end Is_Procedure_Actual;
+
       --------------------
       -- Make_Temporary --
       --------------------
@@ -5422,26 +5447,34 @@ package body Exp_Ch4 is
       --       is caught elsewhere, and the expansion would intefere
       --       with generating the error message).
 
-      if Is_Packed (Typ)
-        and then Nkind (Parent (N)) /= N_Assignment_Statement
-        and then (Nkind (Parent (Parent (N))) /= N_Assignment_Statement
-                     or else
-                  Parent (N) /= Name (Parent (Parent (N))))
-        and then Nkind (Parent (N)) /= N_Indexed_Component
-        and then not Is_Renamed_Object (N)
-        and then Nkind (Parent (N)) /= N_Procedure_Call_Statement
-        and then (Nkind (Parent (N)) /= N_Attribute_Reference
-                    or else
-                  Attribute_Name (Parent (N)) /= Name_Address)
+      if not Is_Packed (Typ) then
+         --  apply transformation for actuals of a function call, where
+         --  Expand_Actuals is not used.
+
+         if Nkind (Parent (N)) = N_Function_Call
+           and then Is_Possibly_Unaligned_Slice (N)
+         then
+            Make_Temporary;
+         end if;
+
+      elsif Nkind (Parent (N)) = N_Assignment_Statement
+        or else (Nkind (Parent (Parent (N))) = N_Assignment_Statement
+                   and then Parent (N) = Name (Parent (Parent (N))))
       then
-         Make_Temporary;
+         return;
 
-      --  Same transformation for actuals in a function call, where
-      --  Expand_Actuals is not used.
+      elsif Nkind (Parent (N)) = N_Indexed_Component
+        or else Is_Renamed_Object (N)
+        or else Is_Procedure_Actual (N)
+      then
+         return;
 
-      elsif Nkind (Parent (N)) = N_Function_Call
-        and then Is_Possibly_Unaligned_Slice (N)
+      elsif (Nkind (Parent (N)) = N_Attribute_Reference
+        and then Attribute_Name (Parent (N)) = Name_Address)
       then
+         return;
+
+      else
          Make_Temporary;
       end if;
    end Expand_N_Slice;