* [Ada] Improved performance of writable actuals aliasing detection
@ 2015-05-26 8:20 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2015-05-26 8:20 UTC (permalink / raw)
To: gcc-patches; +Cc: Javier Miranda
[-- Attachment #1: Type: text/plain, Size: 938 bytes --]
Cleanup the initial version of this patch.
No further test needed.
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-05-26 Javier Miranda <miranda@adacore.com>
* sem_aggr.adb (Resolve_Aggregate, Resolve_Extension_Aggregate):
Code cleanup.
* sem_ch3.adb (Build_Derived_Record_Type,
Record_Type_Declaration): Code cleanup.
* sem_ch4.adb (Has_Arbitrary_Evaluation_Order,
Stop_Subtree_Climbind): Tables which speed up the identification
of dangerous calls to Ada 2012 functions with writable actuals
(AI05-0144).
(Analyze_Arithmetic_Op, Analyze_Call, Analyze_Comparison_Op,
Analyze_Equality_Op, Analyze_Logical_Op, Analyze_Membership_Op,
Analyze_Range): Code cleanup.
(Is_Arbitrary_Evaluation_Order_Construct): Removed.
(Check_Writable_Actuals): Code cleanup using the added tables.
* sem_util.adb (Check_Function_Writable_Actuals): Return
immediately if the node does not have the flag Check_Actuals
set to True.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 12634 bytes --]
Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb (revision 223661)
+++ sem_aggr.adb (working copy)
@@ -1161,9 +1161,7 @@
Set_Analyzed (N);
end if;
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Resolve_Aggregate;
-----------------------------
@@ -2906,9 +2904,7 @@
Error_Msg_N ("no unique type for this aggregate", A);
end if;
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Resolve_Extension_Aggregate;
------------------------------
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 223667)
+++ sem_ch3.adb (working copy)
@@ -8955,9 +8955,7 @@
(Class_Wide_Type (Derived_Type), Last_Entity (Derived_Type));
end if;
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Build_Derived_Record_Type;
------------------------
@@ -21122,9 +21120,7 @@
Derive_Progenitor_Subprograms (T, T);
end if;
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Record_Type_Declaration;
----------------------------
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 223663)
+++ sem_util.adb (working copy)
@@ -2324,11 +2324,12 @@
-- Start of processing for Check_Function_Writable_Actuals
begin
- -- The check only applies to Ada 2012 code, and only to constructs that
- -- have multiple constituents whose order of evaluation is not specified
- -- by the language.
+ -- The check only applies to Ada 2012 code on which Check_Actuals has
+ -- been set, and only to constructs that have multiple constituents
+ -- whose order of evaluation is not specified by the language.
if Ada_Version < Ada_2012
+ or else not Check_Actuals (N)
or else (not (Nkind (N) in N_Op)
and then not (Nkind (N) in N_Membership_Test)
and then not Nkind_In (N, N_Range,
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 223663)
+++ sem_ch4.adb (working copy)
@@ -65,6 +65,110 @@
package body Sem_Ch4 is
+ -- Tables which speed up the identification of dangerous calls to Ada 2012
+ -- functions with writable actuals (AI05-0144).
+
+ -- The following table enumerates the Ada constructs which may evaluate in
+ -- arbitrary order. It does not cover all the language constructs which can
+ -- be evaluated in arbitrary order but the subset needed for AI05-0144.
+
+ Has_Arbitrary_Evaluation_Order : constant array (Node_Kind) of Boolean :=
+ (N_Aggregate => True,
+ N_Assignment_Statement => True,
+ N_Entry_Call_Statement => True,
+ N_Extension_Aggregate => True,
+ N_Full_Type_Declaration => True,
+ N_Indexed_Component => True,
+ N_Object_Declaration => True,
+ N_Pragma => True,
+ N_Range => True,
+ N_Slice => True,
+
+ -- N_Array_Type_Definition
+
+ -- why not
+ -- N_Array_Type_Definition => True,
+ -- etc ???
+
+ N_Constrained_Array_Definition => True,
+ N_Unconstrained_Array_Definition => True,
+
+ -- N_Membership_Test
+
+ N_In => True,
+ N_Not_In => True,
+
+ -- N_Binary_Op
+
+ N_Op_Add => True,
+ N_Op_Concat => True,
+ N_Op_Expon => True,
+ N_Op_Subtract => True,
+
+ N_Op_Divide => True,
+ N_Op_Mod => True,
+ N_Op_Multiply => True,
+ N_Op_Rem => True,
+
+ N_Op_And => True,
+
+ N_Op_Eq => True,
+ N_Op_Ge => True,
+ N_Op_Gt => True,
+ N_Op_Le => True,
+ N_Op_Lt => True,
+ N_Op_Ne => True,
+
+ N_Op_Or => True,
+ N_Op_Xor => True,
+
+ N_Op_Rotate_Left => True,
+ N_Op_Rotate_Right => True,
+ N_Op_Shift_Left => True,
+ N_Op_Shift_Right => True,
+ N_Op_Shift_Right_Arithmetic => True,
+
+ N_Op_Not => True,
+ N_Op_Plus => True,
+
+ -- N_Subprogram_Call
+
+ N_Function_Call => True,
+ N_Procedure_Call_Statement => True,
+
+ others => False);
+
+ -- The following table enumerates the nodes on which we stop climbing when
+ -- locating the outermost Ada construct that can be evaluated in arbitrary
+ -- order.
+
+ Stop_Subtree_Climbing : constant array (Node_Kind) of Boolean :=
+ (N_Aggregate => True,
+ N_Assignment_Statement => True,
+ N_Entry_Call_Statement => True,
+ N_Extended_Return_Statement => True,
+ N_Extension_Aggregate => True,
+ N_Full_Type_Declaration => True,
+ N_Object_Declaration => True,
+ N_Object_Renaming_Declaration => True,
+ N_Package_Specification => True,
+ N_Pragma => True,
+ N_Procedure_Call_Statement => True,
+ N_Simple_Return_Statement => True,
+
+ -- N_Has_Condition
+
+ N_Exit_Statement => True,
+ N_If_Statement => True,
+
+ N_Accept_Alternative => True,
+ N_Delay_Alternative => True,
+ N_Elsif_Part => True,
+ N_Entry_Body_Formal_Part => True,
+ N_Iteration_Scheme => True,
+
+ others => False);
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -830,10 +934,7 @@
end if;
Operator_Check (N);
-
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Analyze_Arithmetic_Op;
------------------
@@ -945,40 +1046,6 @@
-- enabled.
procedure Check_Writable_Actuals (N : Node_Id) is
-
- function Is_Arbitrary_Evaluation_Order_Construct
- (N : Node_Id) return Boolean;
- -- Return True if N is an Ada construct which may be evaluated in
- -- an arbitrary order. This function does not cover all the language
- -- constructs that can be evaluated in arbitrary order, but only the
- -- subset needed for AI05-0144.
-
- ---------------------------------------------
- -- Is_Arbitrary_Evaluation_Order_Construct --
- ---------------------------------------------
-
- function Is_Arbitrary_Evaluation_Order_Construct
- (N : Node_Id) return Boolean is
- begin
- return Nkind (N) = N_Aggregate
- or else Nkind (N) = N_Assignment_Statement
- or else Nkind (N) = N_Full_Type_Declaration
- or else Nkind (N) = N_Entry_Call_Statement
- or else Nkind (N) = N_Extension_Aggregate
- or else Nkind (N) = N_Indexed_Component
- or else Nkind (N) = N_Object_Declaration
- or else Nkind (N) = N_Pragma
- or else Nkind (N) = N_Range
- or else Nkind (N) = N_Slice
-
- or else Nkind (N) in N_Array_Type_Definition
- or else Nkind (N) in N_Membership_Test
- or else Nkind (N) in N_Op
- or else Nkind (N) in N_Subprogram_Call;
- end Is_Arbitrary_Evaluation_Order_Construct;
-
- -- Start of processing for Check_Writable_Actuals
-
begin
if Comes_From_Source (N)
and then Present (Get_Subprogram_Entity (N))
@@ -1010,31 +1077,19 @@
-- to the routine that will later take care of
-- performing the writable actuals check.
- if Is_Arbitrary_Evaluation_Order_Construct (P)
- and then Nkind (P) /= N_Assignment_Statement
- and then Nkind (P) /= N_Object_Declaration
+ if Has_Arbitrary_Evaluation_Order (Nkind (P))
+ and then not Nkind_In (P, N_Assignment_Statement,
+ N_Object_Declaration)
then
Outermost := P;
end if;
-- Avoid climbing more than needed!
- exit when Nkind (P) = N_Aggregate
- or else Nkind (P) = N_Assignment_Statement
- or else Nkind (P) = N_Entry_Call_Statement
- or else Nkind (P) = N_Extended_Return_Statement
- or else Nkind (P) = N_Extension_Aggregate
- or else Nkind (P) = N_Full_Type_Declaration
- or else Nkind (P) = N_Object_Declaration
- or else Nkind (P) = N_Object_Renaming_Declaration
- or else Nkind (P) = N_Package_Specification
- or else Nkind (P) = N_Pragma
- or else Nkind (P) = N_Procedure_Call_Statement
- or else Nkind (P) = N_Simple_Return_Statement
+ exit when Stop_Subtree_Climbing (Nkind (P))
or else (Nkind (P) = N_Range
and then not
- Nkind_In (Parent (P), N_In, N_Not_In))
- or else Nkind (P) in N_Has_Condition;
+ Nkind_In (Parent (P), N_In, N_Not_In));
P := Parent (P);
end loop;
@@ -1411,9 +1466,7 @@
-- an arbitrary order is precisely this call, then check all its
-- actuals.
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end if;
end Analyze_Call;
@@ -1632,10 +1685,7 @@
end if;
Operator_Check (N);
-
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Analyze_Comparison_Op;
---------------------------
@@ -1883,10 +1933,7 @@
end if;
Operator_Check (N);
-
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Analyze_Equality_Op;
----------------------------------
@@ -2710,10 +2757,7 @@
end if;
Operator_Check (N);
-
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Analyze_Logical_Op;
---------------------------
@@ -2869,11 +2913,8 @@
if No (R) and then Ada_Version >= Ada_2012 then
Analyze_Set_Membership;
+ Check_Function_Writable_Actuals (N);
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
-
return;
end if;
@@ -2946,9 +2987,7 @@
Error_Msg_N ("membership test not applicable to cpp-class types", N);
end if;
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Analyze_Membership_Op;
-----------------
@@ -4028,9 +4067,7 @@
Check_Universal_Expression (H);
end if;
- if Check_Actuals (N) then
- Check_Function_Writable_Actuals (N);
- end if;
+ Check_Function_Writable_Actuals (N);
end Analyze_Range;
-----------------------
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2015-05-26 8:18 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-05-26 8:20 [Ada] Improved performance of writable actuals aliasing detection Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).