[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
This commit is contained in:
Arnaud Charlet
parent
44e9f00678
commit
9fbb3ae64a
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
-- 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.
|
||||
|
||||
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
|
||||
-- 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.
|
||||
|
||||
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;
|
||||
|
||||
-- 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 (
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue