* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146189
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
-- 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 ("");
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;
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
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
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 (
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);
for W in Reduced (0) .. WT.Last loop
Free_Word (WT.Table (W));
end loop;
+
IT.Init;
-- Initialize of computation variables
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
(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);
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.
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;
OSDN Git Service
