[multiple changes]

2011-09-01  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch6.ads (Needs_BIP_Alloc_Form): New utility function.
	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
	Test for case where call
	initializes an object of a return statement before testing for
	a constrained call, to ensure that all such cases get handled
	by simply passing on the caller's parameters. Also, in that
	case call Needs_BIP_Alloc_Form to determine whether to pass on
	the BIP_Alloc_Form parameter of the enclosing function rather
	than testing Is_Constrained. Add similar tests for the return
	of a BIP call to later processing to ensure consistent handling.
	(Needs_BIP_Alloc_Form): New utility function.
	* sem_ch6.adb: (Create_Extra_Formals): Replace test for adding
	a BIP_Alloc_Form formal with call to new utility function
	Needs_BIP_Alloc_Form.

2011-09-01  Pascal Obry  <obry@adacore.com>

	* prj-part.adb: Minor reformatting.

2011-09-01  Vincent Celier  <celier@adacore.com>

	* prj-env.adb (Create_Mapping_File.Process): Encode the upper
	half character in the unit name.

From-SVN: r178411

6 files changed, 123 insertions, 58 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 957a04a..83cf332 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2011-09-01  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch6.ads (Needs_BIP_Alloc_Form): New utility function.
+	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
+	Test for case where call
+	initializes an object of a return statement before testing for
+	a constrained call, to ensure that all such cases get handled
+	by simply passing on the caller's parameters. Also, in that
+	case call Needs_BIP_Alloc_Form to determine whether to pass on
+	the BIP_Alloc_Form parameter of the enclosing function rather
+	than testing Is_Constrained. Add similar tests for the return
+	of a BIP call to later processing to ensure consistent handling.
+	(Needs_BIP_Alloc_Form): New utility function.
+	* sem_ch6.adb: (Create_Extra_Formals): Replace test for adding
+	a BIP_Alloc_Form formal with call to new utility function
+	Needs_BIP_Alloc_Form.
+
+2011-09-01  Pascal Obry  <obry@adacore.com>
+
+	* prj-part.adb: Minor reformatting.
+
+2011-09-01  Vincent Celier  <celier@adacore.com>
+
+	* prj-env.adb (Create_Mapping_File.Process): Encode the upper
+	half character in the unit name.
+
 2011-09-01  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch4.adb: Minor code and comment reformatting.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 90fb73e..eb74c12 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4198,7 +4198,6 @@ package body Exp_Ch6 is
                    Constant_Present    => True,
                    Object_Definition   => New_Occurrence_Of (Temp_Typ, Loc),
                    Expression          => New_A);
-
             else
                Decl :=
                  Make_Object_Renaming_Declaration (Loc,
@@ -7579,54 +7578,26 @@ package body Exp_Ch6 is
 
       Result_Subt := Etype (Function_Id);
 
-      --  In the constrained case, add an implicit actual to the function call
-      --  that provides access to the declared object. An unchecked conversion
-      --  to the (specific) result type of the function is inserted to handle
-      --  the case where the object is declared with a class-wide type.
-
-      if Is_Constrained (Underlying_Type (Result_Subt)) then
-         Caller_Object :=
-            Make_Unchecked_Type_Conversion (Loc,
-              Subtype_Mark => New_Reference_To (Result_Subt, Loc),
-              Expression   => New_Reference_To (Obj_Def_Id, Loc));
-
-         --  When the function has a controlling result, an allocation-form
-         --  parameter must be passed indicating that the caller is allocating
-         --  the result object. This is needed because such a function can be
-         --  called as a dispatching operation and must be treated similarly
-         --  to functions with unconstrained result subtypes.
-
-         Add_Alloc_Form_Actual_To_Build_In_Place_Call
-           (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
-
-      --  If the function's result subtype is unconstrained and the object is
-      --  a return object of an enclosing build-in-place function, then the
-      --  implicit build-in-place parameters of the enclosing function must be
-      --  passed along to the called function. (Unfortunately, this won't cover
-      --  the case of extension aggregates where the ancestor part is a build-
-      --  in-place unconstrained function call that should be passed along the
-      --  caller's parameters. Currently those get mishandled by reassigning
-      --  the result of the call to the aggregate return object, when the call
-      --  result should really be directly built in place in the aggregate and
-      --  not built in a temporary. ???)
-
-      elsif Is_Return_Object (Defining_Identifier (Object_Decl)) then
+      --  If the the object is a return object of an enclosing build-in-place
+      --  function, then the implicit build-in-place parameters of the
+      --  enclosing function are simply passed along to the called function.
+      --  (Unfortunately, this won't cover the case of extension aggregates
+      --  where the ancestor part is a build-in-place unconstrained function
+      --  call that should be passed along the caller's parameters. Currently
+      --  those get mishandled by reassigning the result of the call to the
+      --  aggregate return object, when the call result should really be
+      --  directly built in place in the aggregate and not in a temporary. ???)
+
+      if Is_Return_Object (Defining_Identifier (Object_Decl)) then
          Pass_Caller_Acc := True;
 
          Enclosing_Func := Enclosing_Subprogram (Obj_Def_Id);
 
-         --  If the enclosing function has a constrained result type, then
-         --  caller allocation will be used.
-
-         if Is_Constrained (Etype (Enclosing_Func)) then
-            Add_Alloc_Form_Actual_To_Build_In_Place_Call
-              (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
-
-         --  Otherwise, when the enclosing function has an unconstrained result
-         --  type, the BIP_Alloc_Form formal of the enclosing function must be
-         --  passed along to the callee.
+         --  When the enclosing function has a BIP_Alloc_Form formal then we
+         --  pass it along to the callee (such as when the enclosing function
+         --  has an unconstrained or tagged result type).
 
-         else
+         if Needs_BIP_Alloc_Form (Enclosing_Func) then
             Add_Alloc_Form_Actual_To_Build_In_Place_Call
               (Func_Call,
                Function_Id,
@@ -7634,6 +7605,13 @@ package body Exp_Ch6 is
                  New_Reference_To
                    (Build_In_Place_Formal (Enclosing_Func, BIP_Alloc_Form),
                     Loc));
+
+         --  Otherwise, if enclosing function has a constrained result subtype,
+         --  then caller allocation will be used.
+
+         else
+            Add_Alloc_Form_Actual_To_Build_In_Place_Call
+              (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
          end if;
 
          --  Retrieve the BIPacc formal from the enclosing function and convert
@@ -7651,6 +7629,26 @@ package body Exp_Ch6 is
                   (Build_In_Place_Formal (Enclosing_Func, BIP_Object_Access),
                    Loc));
 
+      --  In the constrained case, add an implicit actual to the function call
+      --  that provides access to the declared object. An unchecked conversion
+      --  to the (specific) result type of the function is inserted to handle
+      --  the case where the object is declared with a class-wide type.
+
+      elsif Is_Constrained (Underlying_Type (Result_Subt)) then
+         Caller_Object :=
+            Make_Unchecked_Type_Conversion (Loc,
+              Subtype_Mark => New_Reference_To (Result_Subt, Loc),
+              Expression   => New_Reference_To (Obj_Def_Id, Loc));
+
+         --  When the function has a controlling result, an allocation-form
+         --  parameter must be passed indicating that the caller is allocating
+         --  the result object. This is needed because such a function can be
+         --  called as a dispatching operation and must be treated similarly
+         --  to functions with unconstrained result subtypes.
+
+         Add_Alloc_Form_Actual_To_Build_In_Place_Call
+           (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
+
       --  In other unconstrained cases, pass an indication to do the allocation
       --  on the secondary stack and set Caller_Object to Empty so that a null
       --  value will be passed for the caller's object address. A transient
@@ -7710,11 +7708,14 @@ package body Exp_Ch6 is
       --  The access type and its accompanying object must be inserted after
       --  the object declaration in the constrained case, so that the function
       --  call can be passed access to the object. In the unconstrained case,
-      --  the access type and object must be inserted before the object, since
-      --  the object declaration is rewritten to be a renaming of a dereference
-      --  of the access object.
+      --  or if the object declaration is for a return object, the access type
+      --  and object must be inserted before the object, since the object
+      --  declaration is rewritten to be a renaming of a dereference of the
+      --  access object.
 
-      if Is_Constrained (Underlying_Type (Result_Subt)) then
+      if Is_Constrained (Underlying_Type (Result_Subt))
+        and then not Is_Return_Object (Defining_Identifier (Object_Decl))
+      then
          Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl);
       else
          Insert_Action (Object_Decl, Ptr_Typ_Decl);
@@ -7734,11 +7735,18 @@ package body Exp_Ch6 is
           Object_Definition   => New_Reference_To (Ref_Type, Loc),
           Expression          => New_Expr));
 
-      if Is_Constrained (Underlying_Type (Result_Subt)) then
+      --  If the result subtype of the called function is constrained and
+      --  is not itself the return expression of an enclosing BIP function,
+      --  then mark the object as having no initialization.
+
+      if Is_Constrained (Underlying_Type (Result_Subt))
+        and then not Is_Return_Object (Defining_Identifier (Object_Decl))
+      then
          Set_Expression (Object_Decl, Empty);
          Set_No_Initialization (Object_Decl);
 
-      --  In case of an unconstrained result subtype, rewrite the object
+      --  In case of an unconstrained result subtype, or if the call is the
+      --  return expression of an enclosing BIP function, rewrite the object
       --  declaration as an object renaming where the renamed object is a
       --  dereference of <function_Call>'reference:
       --
@@ -7830,4 +7838,16 @@ package body Exp_Ch6 is
           and then Needs_Finalization (Func_Typ);
    end Needs_BIP_Finalization_Master;
 
+   --------------------------
+   -- Needs_BIP_Alloc_Form --
+   --------------------------
+
+   function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean is
+      pragma Assert (Is_Build_In_Place_Function (Func_Id));
+      Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
+
+   begin
+      return not Is_Constrained (Func_Typ) or else Is_Tagged_Type (Func_Typ);
+   end Needs_BIP_Alloc_Form;
+
 end Exp_Ch6;
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index 95a10ec..29dc273 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -198,7 +198,11 @@ package Exp_Ch6 is
    --  node applied to such a function call.
 
    function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean;
-   --  Ada 2005 (AI-318-02): Return True if the function needs a finalization
-   --  master implicit parameter.
+   --  Ada 2005 (AI-318-02): Return True if the function needs an implicit
+   --  finalization master implicit parameter.
+
+   function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean;
+   --  Ada 2005 (AI-318-02): Return True if the function needs an implicit
+   --  BIP_Alloc_Form parameter (see type BIP_Formal_Kind).
 
 end Exp_Ch6;
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 0c80f7f..68965ab 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -836,7 +836,24 @@ package body Prj.Env is
                   or else Source.Unit /= No_Unit_Index)
             then
                if Source.Unit /= No_Unit_Index then
-                  Get_Name_String (Source.Unit.Name);
+                  --  Put the encoded unit name in the name buffer
+
+                  declare
+                     Uname : constant String :=
+                       Get_Name_String (Source.Unit.Name);
+
+                  begin
+                     Name_Len := 0;
+
+                     for J in Uname'Range loop
+                        if Uname (J) in Upper_Half_Character then
+                           Store_Encoded_Character (Get_Char_Code (Uname (J)));
+
+                        else
+                           Add_Char_To_Name_Buffer (Uname (J));
+                        end if;
+                     end loop;
+                  end;
 
                   if Source.Language.Config.Kind = Unit_Based then
 
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index 8985e97..3b07a80 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -1037,8 +1037,8 @@ package body Prj.Part is
                Proj_Qualifier := Aggregate;
                Scan (In_Tree);
 
-               if Token = Tok_Identifier and then
-                 Token_Name = Snames.Name_Library
+               if Token = Tok_Identifier
+                 and then Token_Name = Snames.Name_Library
                then
                   Proj_Qualifier := Aggregate_Library;
                   Scan (In_Tree);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d3dfedd..7b4bf91 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6120,9 +6120,7 @@ package body Sem_Ch6 is
             --  dispatching context and such calls must be handled like calls
             --  to a class-wide function.
 
-            if not Is_Constrained (Underlying_Type (Result_Subt))
-              or else Is_Tagged_Type (Underlying_Type (Result_Subt))
-            then
+            if Needs_BIP_Alloc_Form (E) then
                Discard :=
                  Add_Extra_Formal
                    (E, Standard_Natural,