From e239bda8a289bbae40246dd2fb918e959a39e3f5 Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 16 Apr 2009 13:19:37 +0000 Subject: [PATCH] 2009-04-16 Robert Dewar * 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 * 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 * exp_ch3.adb (Expand_N_Object_Declaration): In case of build-in-place objects avoid any further expansion of the expression initializing the object. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146189 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 22 ++++++++++++++++++++++ gcc/ada/bindgen.adb | 4 ++-- gcc/ada/exp_ch3.adb | 32 +++++++++++++++++--------------- gcc/ada/exp_dist.adb | 6 +++--- gcc/ada/g-pehage.adb | 1 + gcc/ada/sem_ch12.adb | 6 ++++-- gcc/ada/sem_eval.adb | 26 ++++++++++++++++++++++++++ 7 files changed, 75 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fa835267d9d..4280b92150b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2009-04-16 Robert Dewar + + * 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 + + * 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 + + * 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 * 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 cc4c6ddfa5d..ce81c7ae005 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 b9b0054fb03..570b1f8aa5d 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 28916b02935..58a128e6306 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 93f05b82460..5abb04c2138 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 21da8901fcd..8902d0d546b 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 596b4aff1be..627ea5bf9bb 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; -- 2.11.0