Commit 9fbb3ae6 by Arnaud Charlet

[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
parent 44e9f006
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> 2009-04-16 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Preanalyze_Actuals): If the instance is a child unit * sem_ch12.adb (Preanalyze_Actuals): If the instance is a child unit
...@@ -2273,7 +2273,7 @@ package body Bindgen is ...@@ -2273,7 +2273,7 @@ package body Bindgen is
-- If the standard library is not suppressed, these variables -- If the standard library is not suppressed, these variables
-- are in the runtime data area for easy access from the -- are in the runtime data area for easy access from the
-- runtime -- runtime.
if not Suppress_Standard_Library_On_Target then if not Suppress_Standard_Library_On_Target then
WBI (""); WBI ("");
...@@ -2510,7 +2510,7 @@ package body Bindgen is ...@@ -2510,7 +2510,7 @@ package body Bindgen is
Gen_Adainit_Ada; 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 if not Cumulative_Restrictions.Set (No_Finalization) then
Gen_Adafinal_Ada; Gen_Adafinal_Ada;
......
...@@ -4145,7 +4145,6 @@ package body Exp_Ch3 is ...@@ -4145,7 +4145,6 @@ package body Exp_Ch3 is
Expr_Q : Node_Id; Expr_Q : Node_Id;
Id_Ref : Node_Id; Id_Ref : Node_Id;
New_Ref : Node_Id; New_Ref : Node_Id;
BIP_Call : Boolean := False;
Init_After : Node_Id := N; Init_After : Node_Id := N;
-- Node after which the init proc call is to be inserted. This is -- Node after which the init proc call is to be inserted. This is
...@@ -4409,21 +4408,25 @@ package body Exp_Ch3 is ...@@ -4409,21 +4408,25 @@ package body Exp_Ch3 is
if Is_Delayed_Aggregate (Expr_Q) then if Is_Delayed_Aggregate (Expr_Q) then
Convert_Aggr_In_Object_Decl (N); Convert_Aggr_In_Object_Decl (N);
else -- Ada 2005 (AI-318-02): If the initialization expression is a call
-- Ada 2005 (AI-318-02): If the initialization expression is a -- to a build-in-place function, then access to the declared object
-- call to a build-in-place function, then access to the declared -- must be passed to the function. Currently we limit such functions
-- object must be passed to the function. Currently we limit such -- to those with constrained limited result subtypes, but eventually
-- functions to those with constrained limited result subtypes, -- plan to expand the allowed forms of functions that are treated as
-- but eventually we plan to expand the allowed forms of functions -- build-in-place.
-- that are treated as build-in-place.
if Ada_Version >= Ada_05 elsif Ada_Version >= Ada_05
and then Is_Build_In_Place_Function_Call (Expr_Q) and then Is_Build_In_Place_Function_Call (Expr_Q)
then then
Make_Build_In_Place_Call_In_Object_Declaration (N, Expr_Q); Make_Build_In_Place_Call_In_Object_Declaration (N, Expr_Q);
BIP_Call := True;
end if;
-- 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 -- In most cases, we must check that the initial value meets any
-- constraint imposed by the declared type. However, there is one -- constraint imposed by the declared type. However, there is one
-- very important exception to this rule. If the entity has an -- very important exception to this rule. If the entity has an
...@@ -4571,7 +4574,6 @@ package body Exp_Ch3 is ...@@ -4571,7 +4574,6 @@ package body Exp_Ch3 is
if Needs_Finalization (Typ) if Needs_Finalization (Typ)
and then not Is_Inherently_Limited_Type (Typ) and then not Is_Inherently_Limited_Type (Typ)
and then not BIP_Call
then then
Insert_Actions_After (Init_After, Insert_Actions_After (Init_After,
Make_Adjust_Call ( Make_Adjust_Call (
......
...@@ -7667,9 +7667,9 @@ package body Exp_Dist is ...@@ -7667,9 +7667,9 @@ package body Exp_Dist is
Request := Make_Defining_Identifier (Loc, Name_R); Request := Make_Defining_Identifier (Loc, Name_R);
RPC_Receiver_Spec := RPC_Receiver_Spec :=
Build_RPC_Receiver_Specification ( Build_RPC_Receiver_Specification
RPC_Receiver => RPC_Receiver, (RPC_Receiver => RPC_Receiver,
Request_Parameter => Request); Request_Parameter => Request);
Subp_Id := Make_Defining_Identifier (Loc, Name_P); Subp_Id := Make_Defining_Identifier (Loc, Name_P);
Subp_Index := Make_Defining_Identifier (Loc, Name_I); Subp_Index := Make_Defining_Identifier (Loc, Name_I);
......
...@@ -1149,6 +1149,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1149,6 +1149,7 @@ package body GNAT.Perfect_Hash_Generators is
for W in Reduced (0) .. WT.Last loop for W in Reduced (0) .. WT.Last loop
Free_Word (WT.Table (W)); Free_Word (WT.Table (W));
end loop; end loop;
IT.Init; IT.Init;
-- Initialize of computation variables -- Initialize of computation variables
......
...@@ -10888,10 +10888,10 @@ package body Sem_Ch12 is ...@@ -10888,10 +10888,10 @@ package body Sem_Ch12 is
Act : Node_Id; Act : Node_Id;
Errs : constant Int := Serious_Errors_Detected; Errs : constant Int := Serious_Errors_Detected;
Cur : Entity_Id := Empty; Cur : Entity_Id := Empty;
-- Current homograph of the instance name -- Current homograph of the instance name
Vis : Boolean; Vis : Boolean;
-- Saved visibility status of the current homograph -- Saved visibility status of the current homograph
begin begin
...@@ -10905,6 +10905,7 @@ package body Sem_Ch12 is ...@@ -10905,6 +10905,7 @@ package body Sem_Ch12 is
(Current_Entity (Defining_Identifier (Defining_Unit_Name (N)))) (Current_Entity (Defining_Identifier (Defining_Unit_Name (N))))
then then
Cur := Current_Entity (Defining_Identifier (Defining_Unit_Name (N))); Cur := Current_Entity (Defining_Identifier (Defining_Unit_Name (N)));
if Is_Compilation_Unit (Cur) then if Is_Compilation_Unit (Cur) then
Vis := Is_Immediately_Visible (Cur); Vis := Is_Immediately_Visible (Cur);
Set_Is_Immediately_Visible (Cur, False); Set_Is_Immediately_Visible (Cur, False);
...@@ -10991,6 +10992,7 @@ package body Sem_Ch12 is ...@@ -10991,6 +10992,7 @@ package body Sem_Ch12 is
end if; end if;
if Present (Cur) then if Present (Cur) then
-- For the case of a child instance hiding an outer homonym, -- For the case of a child instance hiding an outer homonym,
-- provide additional warning which might explain the error. -- provide additional warning which might explain the error.
......
...@@ -1779,6 +1779,32 @@ package body Sem_Eval is ...@@ -1779,6 +1779,32 @@ package body Sem_Eval is
Set_Sloc (N, Loc); Set_Sloc (N, Loc);
end if; end if;
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 if; end if;
end; end;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment