With the rewriting of the GNATprove mode of the frontend, the pseudo-flag
Full_Expander_Active is now the same as Expander_Active, so remove it.
Also, the special rewriting of renamings into renamed subprograms for each call
done in GNATprove mode is now moved to the GNATprove backend.
2014-01-20 Yannick Moy <m...@adacore.com>
* exp_spark.adb (Expand_SPARK_Call): Remove procedure.
* opt.adb, opt.ads (Full_Expander_Active): Remove function.
* checks.adb, exp_ch6.adb, exp_ch9.adb, exp_disp.adb, sem_aggr.adb,
* sem_ch10.adb, sem_ch5.adb, sem_ch6.adb, sem_ch8.adb, sem_ch9.adb,
* sem_disp.adb, sem_res.adb Replace Full_Expander_Active by
Expander_Active.
Index: checks.adb
===================================================================
--- checks.adb (revision 206804)
+++ checks.adb (working copy)
@@ -478,7 +478,7 @@
-- are cases (e.g. with pragma Debug) where generating the checks
-- can cause real trouble).
- if not Full_Expander_Active then
+ if not Expander_Active then
return;
end if;
@@ -960,7 +960,7 @@
if Backend_Overflow_Checks_On_Target
or else not Do_Overflow_Check (N)
- or else not Full_Expander_Active
+ or else not Expander_Active
or else (Present (Parent (N))
and then Nkind (Parent (N)) = N_Type_Conversion
and then Integer_Promotion_Possible (Parent (N)))
@@ -1419,7 +1419,7 @@
-- Nothing to do if discriminant checks are suppressed or else no code
-- is to be generated
- if not Full_Expander_Active
+ if not Expander_Active
or else Discriminant_Checks_Suppressed (T_Typ)
then
return;
@@ -1732,7 +1732,7 @@
-- Proceed here in SUPPRESSED or CHECKED modes
- if Full_Expander_Active
+ if Expander_Active
and then not Backend_Divide_Checks_On_Target
and then Check_Needed (Right, Division_Check)
then
@@ -1803,7 +1803,7 @@
Right : constant Node_Id := Right_Opnd (N);
begin
- if Full_Expander_Active
+ if Expander_Active
and then not Backend_Divide_Checks_On_Target
and then Check_Needed (Right, Division_Check)
then
@@ -1914,7 +1914,7 @@
-- the frontend to expand these checks, which are dealt with directly
-- in the formal verification backend.
- if not Full_Expander_Active then
+ if not Expander_Active then
return;
end if;
@@ -2945,7 +2945,7 @@
or else (not Length_Checks_Suppressed (Target_Typ));
begin
- if not Full_Expander_Active then
+ if not Expander_Active then
return;
end if;
@@ -3052,7 +3052,7 @@
or else (not Range_Checks_Suppressed (Target_Typ));
begin
- if not Full_Expander_Active or else not Checks_On then
+ if not Expander_Active or else not Checks_On then
return;
end if;
@@ -6290,7 +6290,7 @@
-- enhanced to check for an always True value in the condition and to
-- generate a compilation warning???
- if not Full_Expander_Active or else not Checks_On then
+ if not Expander_Active or else not Checks_On then
return;
end if;
@@ -8321,7 +8321,7 @@
-- Start of processing for Selected_Length_Checks
begin
- if not Full_Expander_Active then
+ if not Expander_Active then
return Ret_Result;
end if;
@@ -8871,7 +8871,7 @@
-- Start of processing for Selected_Range_Checks
begin
- if not Full_Expander_Active then
+ if not Expander_Active then
return Ret_Result;
end if;
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 206804)
+++ exp_ch6.adb (working copy)
@@ -9603,7 +9603,7 @@
-- may end up with a call that is neither resolved to an entity, nor
-- an indirect call.
- if not Full_Expander_Active then
+ if not Expander_Active then
return False;
end if;
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 206804)
+++ exp_ch9.adb (working copy)
@@ -5813,7 +5813,7 @@
Ldecl2 : Node_Id;
begin
- if Full_Expander_Active then
+ if Expander_Active then
-- If we have no handled statement sequence, we may need to build
-- a dummy sequence consisting of a null statement. This can be
@@ -6123,7 +6123,7 @@
-- barrier just as a protected function, and discard the protected
-- version of it because it is never called.
- if Full_Expander_Active then
+ if Expander_Active then
B_F := Build_Barrier_Function (N, Ent, Prot);
Func := Barrier_Function (Ent);
Set_Corresponding_Spec (B_F, Func);
@@ -6161,7 +6161,7 @@
-- condition does not reference any of the generated renamings
-- within the function.
- if Full_Expander_Active and then Scope (Entity (Cond)) /= Func then
+ if Expander_Active and then Scope (Entity (Cond)) /= Func then
Set_Declarations (B_F, Empty_List);
end if;
@@ -12497,7 +12497,7 @@
Error_Msg_CRT ("protected body", N);
return;
- elsif Full_Expander_Active then
+ elsif Expander_Active then
-- Associate discriminals with the first subprogram or entry body to
-- be expanded.
Index: exp_disp.adb
===================================================================
--- exp_disp.adb (revision 206804)
+++ exp_disp.adb (working copy)
@@ -696,7 +696,7 @@
-- Expand_Dispatching_Call is called directly from the semantics,
-- so we only proceed if the expander is active.
- if not Full_Expander_Active
+ if not Expander_Active
-- And there is no need to expand the call if we are compiling under
-- restriction No_Dispatching_Calls; the semantic analyzer has
Index: exp_spark.adb
===================================================================
--- exp_spark.adb (revision 206805)
+++ exp_spark.adb (working copy)
@@ -27,7 +27,6 @@
with Einfo; use Einfo;
with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util;
-with Sem_Aux; use Sem_Aux;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
@@ -38,10 +37,6 @@
-- Local Subprograms --
-----------------------
- procedure Expand_SPARK_Call (N : Node_Id);
- -- This procedure contains common processing for function and procedure
- -- calls: replacement of renaming by subprogram renamed
-
procedure Expand_SPARK_N_Object_Renaming_Declaration (N : Node_Id);
-- Perform name evaluation for a renamed object
@@ -71,9 +66,6 @@
N_Subprogram_Body =>
Qualify_Entity_Names (N);
- when N_Subprogram_Call =>
- Expand_SPARK_Call (N);
-
when N_Expanded_Name |
N_Identifier =>
Expand_Potential_Renaming (N);
@@ -88,36 +80,6 @@
end case;
end Expand_SPARK;
- -----------------------
- -- Expand_SPARK_Call --
- -----------------------
-
- procedure Expand_SPARK_Call (N : Node_Id) is
- begin
- -- If the subprogram is a renaming, replace it in the call with the name
- -- of the actual subprogram being called. We distinguish renamings from
- -- inherited primitive operations, which both have an Alias component,
- -- by looking at the parent node of the entity. The entity for a
- -- renaming has the function or procedure specification node as
- -- parent, while an inherited primitive operation has the derived
- -- type declaration as parent.
-
- if Nkind (Name (N)) in N_Has_Entity
- and then Present (Entity (Name (N)))
- then
- declare
- E : constant Entity_Id := Entity (Name (N));
- begin
- if Nkind_In (Parent (E), N_Function_Specification,
- N_Procedure_Specification)
- and then Present (Alias (E))
- then
- Set_Entity (Name (N), Ultimate_Alias (E));
- end if;
- end;
- end if;
- end Expand_SPARK_Call;
-
------------------------------------------------
-- Expand_SPARK_N_Object_Renaming_Declaration --
------------------------------------------------
Index: opt.adb
===================================================================
--- opt.adb (revision 206805)
+++ opt.adb (working copy)
@@ -38,15 +38,6 @@
SU : constant := Storage_Unit;
-- Shorthand for System.Storage_Unit
- --------------------------
- -- Full_Expander_Active --
- --------------------------
-
- function Full_Expander_Active return Boolean is
- begin
- return Expander_Active;
- end Full_Expander_Active;
-
----------------------------------
-- Register_Opt_Config_Switches --
----------------------------------
Index: opt.ads
===================================================================
--- opt.ads (revision 206805)
+++ opt.ads (working copy)
@@ -1939,9 +1939,6 @@
-- this flag, see package Expander. Indeed this flag might more logically
-- be in the spec of Expander, but it is referenced by Errout, and it
-- really seems wrong for Errout to depend on Expander.
- --
- -- Note: for many purposes, it is more appropriate to test the flag
- -- Full_Expander_Active, which also checks that SPARK mode is not active.
Static_Dispatch_Tables : Boolean := True;
-- This flag indicates if the backend supports generation of statically
@@ -2023,15 +2020,6 @@
-- for integers are limited to the strict minimum with this option. Set by
-- debug flag -gnatd.D.
- function Full_Expander_Active return Boolean;
- pragma Inline (Full_Expander_Active);
- -- Returns the value of (Expander_Active and not SPARK_Mode). This "flag"
- -- indicates that expansion is fully active, that is, not in the reduced
- -- mode for SPARK (True) or that expansion is either deactivated, or active
- -- in the reduced mode for SPARK (False). For more information on full
- -- expansion, see package Expander. For more information on reduced
- -- SPARK expansion, see package Exp_SPARK.
-
private
-- The following type is used to save and restore settings of switches in
Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb (revision 206805)
+++ sem_aggr.adb (working copy)
@@ -1700,7 +1700,7 @@
-- performed safely.
if Single_Elmt
- or else not Full_Expander_Active
+ or else not Expander_Active
or else In_Spec_Expression
then
Analyze_And_Resolve (Expr, Component_Typ);
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 206804)
+++ sem_ch10.adb (working copy)
@@ -2393,7 +2393,7 @@
-- expansion is active, because the context may be generic and the
-- flag not defined yet.
- if Full_Expander_Active then
+ if Expander_Active then
Insert_After (N,
Make_Assignment_Statement (Loc,
Name =>
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb (revision 206805)
+++ sem_ch5.adb (working copy)
@@ -2739,7 +2739,7 @@
if No (Iter)
or else No (Iterator_Specification (Iter))
- or else not Full_Expander_Active
+ or else not Expander_Active
then
if Present (Iter)
and then Present (Iterator_Specification (Iter))
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 206805)
+++ sem_ch6.adb (working copy)
@@ -3200,7 +3200,7 @@
-- body may be the rewritting of an expression function, and we need to
-- verify that the original node is in the source.
- if Full_Expander_Active
+ if Expander_Active
and then Comes_From_Source (Original_Node (N))
and then Present (Prot_Typ)
and then Present (Spec_Id)
@@ -11447,7 +11447,7 @@
-- parameter block, and it is this local variable that may
-- require an actual subtype.
- if Full_Expander_Active then
+ if Expander_Active then
Decl := Build_Actual_Subtype (T, Renamed_Object (Formal));
else
Decl := Build_Actual_Subtype (T, Formal);
@@ -11486,7 +11486,7 @@
end if;
if Nkind (N) = N_Accept_Statement
- and then Full_Expander_Active
+ and then Expander_Active
then
Set_Actual_Subtype (Renamed_Object (Formal),
Defining_Identifier (Decl));
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 206805)
+++ sem_ch8.adb (working copy)
@@ -2203,7 +2203,7 @@
if Is_Actual
and then Is_Abstract_Subprogram (Formal_Spec)
- and then Full_Expander_Active
+ and then Expander_Active
then
declare
Stream_Prim : Entity_Id;
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb (revision 206804)
+++ sem_ch9.adb (working copy)
@@ -1326,7 +1326,7 @@
-- for the discriminals and privals and finally a declaration for the
-- entry family index (if applicable).
- if Full_Expander_Active
+ if Expander_Active
and then Is_Protected_Type (P_Type)
then
Install_Private_Data_Declarations
@@ -2142,7 +2142,7 @@
-- Also skip if expander is not active
- and then Full_Expander_Active
+ and then Expander_Active
then
Expand_N_Protected_Type_Declaration (N);
Process_Full_View (N, T, Def_Id);
@@ -2990,7 +2990,7 @@
-- Also skip if expander is not active
- and then Full_Expander_Active
+ and then Expander_Active
then
Expand_N_Task_Type_Declaration (N);
Process_Full_View (N, T, Def_Id);
Index: sem_disp.adb
===================================================================
--- sem_disp.adb (revision 206804)
+++ sem_disp.adb (working copy)
@@ -1264,7 +1264,7 @@
-- emitted after those tables are built, to prevent access before
-- elaboration in gigi.
- if Body_Is_Last_Primitive and then Full_Expander_Active then
+ if Body_Is_Last_Primitive and then Expander_Active then
declare
Subp_Body : constant Node_Id := Unit_Declaration_Node (Subp);
Elmt : Elmt_Id;
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 206805)
+++ sem_res.adb (working copy)
@@ -1762,7 +1762,7 @@
-- Start of processing for Replace_Actual_Discriminants
begin
- if not Full_Expander_Active then
+ if not Expander_Active then
return;
end if;
@@ -2033,7 +2033,7 @@
-- If we are generating code in distributed mode, perform
-- semantic checks against corresponding remote entities.
- if Full_Expander_Active
+ if Expander_Active
and then Get_PCS_Name /= Name_No_DSA
then
Check_Subtype_Conformant
@@ -3608,7 +3608,7 @@
elsif Nkind (A) = N_Function_Call
and then Is_Limited_Record (Etype (F))
and then not Is_Constrained (Etype (F))
- and then Full_Expander_Active
+ and then Expander_Active
and then (Is_Controlled (Etype (F)) or else Has_Task (Etype (F)))
then
Establish_Transient_Scope (A, Sec_Stack => False);
@@ -3624,7 +3624,7 @@
elsif Nkind (A) = N_Op_Concat
and then Nkind (N) = N_Procedure_Call_Statement
- and then Full_Expander_Active
+ and then Expander_Active
and then
not (Is_Intrinsic_Subprogram (Nam)
and then Chars (Nam) = Name_Asm)
@@ -3687,7 +3687,7 @@
-- be removed in the expansion of the wrapped construct.
if (Is_Controlled (DDT) or else Has_Task (DDT))
- and then Full_Expander_Active
+ and then Expander_Active
then
Establish_Transient_Scope (A, Sec_Stack => False);
end if;
@@ -5756,7 +5756,7 @@
then
null;
- elsif Full_Expander_Active
+ elsif Expander_Active
and then Is_Type (Etype (Nam))
and then Requires_Transient_Scope (Etype (Nam))
and then
@@ -6836,7 +6836,7 @@
-- Protected functions can return on the secondary stack, in which
-- case we must trigger the transient scope mechanism.
- elsif Full_Expander_Active
+ elsif Expander_Active
and then Requires_Transient_Scope (Etype (Nam))
then
Establish_Transient_Scope (N, Sec_Stack => True);
@@ -7139,7 +7139,7 @@
-- Why the Expander_Active test here ???
- if Full_Expander_Active
+ if Expander_Active
and then
(Ekind_In (T, E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type)
@@ -7551,7 +7551,7 @@
-- We must preserve the original entity in a generic setting, so that
-- the legality of the operation can be verified in an instance.
- if not Full_Expander_Active then
+ if not Expander_Active then
return;
end if;
@@ -8670,7 +8670,7 @@
-- transformation while analyzing generic units, as type information
-- would be lost when reanalyzing the constant node in the instance.
- if Is_Discrete_Type (Typ) and then Full_Expander_Active then
+ if Is_Discrete_Type (Typ) and then Expander_Active then
if Is_OK_Static_Expression (L) then
Fold_Uint (L, Expr_Value (L), Is_Static_Expression (L));
end if;
@@ -9022,7 +9022,7 @@
-- helpful for coverage analysis. However this should not happen in
-- generics.
- if Full_Expander_Active then
+ if Expander_Active then
declare
Reloc_L : constant Node_Id := Relocate_Node (L);
begin
@@ -9877,7 +9877,7 @@
-- expression coincides with the target type.
if Ada_Version >= Ada_2005
- and then Full_Expander_Active
+ and then Expander_Active
and then Operand_Typ /= Target_Typ
then
declare
@@ -10387,7 +10387,7 @@
-- premature (e.g. if the slice is within a transient scope). This needs
-- to be done only if expansion is enabled.
- elsif Full_Expander_Active then
+ elsif Expander_Active then
Ensure_Defined (Typ => Slice_Subtype, N => N);
end if;
end Set_Slice_Subtype;
