[multiple changes]

2009-04-16  Robert Dewar  <dewar@adacore.com>

	* g-pehage.adb: Minor reformatting

	* sem_ch12.adb: Minor reformatting

	* exp_dist.adb: Minor reformatting

	* bindgen.adb: Minor style fixes.

2009-04-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_eval.adb (Eval_Indexed_Component): Extend constant-folding of
	indexed components to the case where the prefix is a static string
	literal.

2009-04-16  Javier Miranda  <miranda@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): In case of build-in-place
	objects avoid any further expansion of the expression initializing the
	object.

From-SVN: r146189

7 files changed, 75 insertions, 22 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fa83526..4280b92 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2009-04-16  Robert Dewar  <dewar@adacore.com>
+
+	* g-pehage.adb: Minor reformatting
+
+	* sem_ch12.adb: Minor reformatting
+
+	* exp_dist.adb: Minor reformatting
+
+	* bindgen.adb: Minor style fixes.
+
+2009-04-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_eval.adb (Eval_Indexed_Component): Extend constant-folding of
+	indexed components to the case where the prefix is a static string
+	literal.
+
+2009-04-16  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): In case of build-in-place
+	objects avoid any further expansion of the expression initializing the
+	object.
+
 2009-04-16  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch12.adb (Preanalyze_Actuals): If the instance is a child unit
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index cc4c6dd..ce81c7a 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -2273,7 +2273,7 @@ package body Bindgen is
 
                --  If the standard library is not suppressed, these variables
                --  are in the runtime data area for easy access from the
-               --  runtime
+               --  runtime.
 
                if not Suppress_Standard_Library_On_Target then
                   WBI ("");
@@ -2510,7 +2510,7 @@ package body Bindgen is
 
       Gen_Adainit_Ada;
 
-      --  Generate the adafinal routine unless there is no finalization to do.
+      --  Generate the adafinal routine unless there is no finalization to do
 
       if not Cumulative_Restrictions.Set (No_Finalization) then
          Gen_Adafinal_Ada;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index b9b0054..570b1f8 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4145,7 +4145,6 @@ package body Exp_Ch3 is
       Expr_Q   : Node_Id;
       Id_Ref   : Node_Id;
       New_Ref  : Node_Id;
-      BIP_Call : Boolean := False;
 
       Init_After : Node_Id := N;
       --  Node after which the init proc call is to be inserted. This is
@@ -4409,21 +4408,25 @@ package body Exp_Ch3 is
          if Is_Delayed_Aggregate (Expr_Q) then
             Convert_Aggr_In_Object_Decl (N);
 
-         else
-            --  Ada 2005 (AI-318-02): If the initialization expression is a
-            --  call to a build-in-place function, then access to the declared
-            --  object must be passed to the function. Currently we limit such
-            --  functions to those with constrained limited result subtypes,
-            --  but eventually we plan to expand the allowed forms of functions
-            --  that are treated as build-in-place.
+         --  Ada 2005 (AI-318-02): If the initialization expression is a call
+         --  to a build-in-place function, then access to the declared object
+         --  must be passed to the function. Currently we limit such functions
+         --  to those with constrained limited result subtypes, but eventually
+         --  plan to expand the allowed forms of functions that are treated as
+         --  build-in-place.
 
-            if Ada_Version >= Ada_05
-              and then Is_Build_In_Place_Function_Call (Expr_Q)
-            then
-               Make_Build_In_Place_Call_In_Object_Declaration (N, Expr_Q);
-               BIP_Call := True;
-            end if;
+         elsif Ada_Version >= Ada_05
+           and then Is_Build_In_Place_Function_Call (Expr_Q)
+         then
+            Make_Build_In_Place_Call_In_Object_Declaration (N, Expr_Q);
 
+            --  The previous call expands the expression initializing the
+            --  built-in-place object into further code that will be analyzed
+            --  later. No further expansion needed here.
+
+            return;
+
+         else
             --  In most cases, we must check that the initial value meets any
             --  constraint imposed by the declared type. However, there is one
             --  very important exception to this rule. If the entity has an
@@ -4571,7 +4574,6 @@ package body Exp_Ch3 is
 
             if Needs_Finalization (Typ)
               and then not Is_Inherently_Limited_Type (Typ)
-              and then not BIP_Call
             then
                Insert_Actions_After (Init_After,
                  Make_Adjust_Call (
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 28916b0..58a128e6 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -7667,9 +7667,9 @@ package body Exp_Dist is
          Request := Make_Defining_Identifier (Loc, Name_R);
 
          RPC_Receiver_Spec :=
-           Build_RPC_Receiver_Specification (
-             RPC_Receiver      => RPC_Receiver,
-             Request_Parameter => Request);
+           Build_RPC_Receiver_Specification
+             (RPC_Receiver      => RPC_Receiver,
+              Request_Parameter => Request);
 
          Subp_Id    := Make_Defining_Identifier (Loc, Name_P);
          Subp_Index := Make_Defining_Identifier (Loc, Name_I);
diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb
index 93f05b8..5abb04c 100644
--- a/gcc/ada/g-pehage.adb
+++ b/gcc/ada/g-pehage.adb
@@ -1149,6 +1149,7 @@ package body GNAT.Perfect_Hash_Generators is
       for W in Reduced (0) .. WT.Last loop
          Free_Word (WT.Table (W));
       end loop;
+
       IT.Init;
 
       --  Initialize of computation variables
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 21da890..8902d0d 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -10888,10 +10888,10 @@ package body Sem_Ch12 is
       Act   : Node_Id;
       Errs  : constant Int := Serious_Errors_Detected;
 
-      Cur   : Entity_Id := Empty;
+      Cur : Entity_Id := Empty;
       --  Current homograph of the instance name
 
-      Vis   : Boolean;
+      Vis : Boolean;
       --  Saved visibility status of the current homograph
 
    begin
@@ -10905,6 +10905,7 @@ package body Sem_Ch12 is
           (Current_Entity (Defining_Identifier (Defining_Unit_Name (N))))
       then
          Cur := Current_Entity (Defining_Identifier (Defining_Unit_Name (N)));
+
          if Is_Compilation_Unit (Cur) then
             Vis := Is_Immediately_Visible (Cur);
             Set_Is_Immediately_Visible (Cur, False);
@@ -10991,6 +10992,7 @@ package body Sem_Ch12 is
                end if;
 
                if Present (Cur) then
+
                   --  For the case of a child instance hiding an outer homonym,
                   --  provide additional warning which might explain the error.
 
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 596b4af..627ea5b 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -1779,6 +1779,32 @@ package body Sem_Eval is
                         Set_Sloc (N, Loc);
                      end if;
                   end if;
+
+               --  We can also constant-fold if the prefix is a string literal.
+               --  This will be useful in an instantiation or an inlining.
+
+               elsif Compile_Time_Known_Value (Sub)
+                 and then Nkind (Arr) = N_String_Literal
+                 and then Compile_Time_Known_Value (Lbd)
+                 and then Expr_Value (Lbd) = 1
+                 and then Expr_Value (Sub) <=
+                   String_Literal_Length (Etype (Arr))
+               then
+                  declare
+                     C : constant Char_Code :=
+                           Get_String_Char (Strval (Arr),
+                             UI_To_Int (Expr_Value (Sub)));
+                  begin
+                     Set_Character_Literal_Name (C);
+
+                     Elm :=
+                       Make_Character_Literal (Loc,
+                         Chars              => Name_Find,
+                         Char_Literal_Value => UI_From_CC (C));
+                     Set_Etype (Elm, Component_Type (Atyp));
+                     Rewrite (N, Duplicate_Subexpr_No_Checks (Elm));
+                     Set_Is_Static_Expression (N, False);
+                  end;
                end if;
             end if;
          end;