===================================================================
@@ -9581,6 +9581,65 @@
and then Nkind (Node (First_Elmt (Constits))) /= N_Null;
end Has_Non_Null_Refinement;
+ -------------------
+ -- Has_Null_Body --
+ -------------------
+
+ function Has_Null_Body (Proc_Id : Entity_Id) return Boolean is
+ Body_Id : Entity_Id;
+ Decl : Node_Id;
+ Spec : Node_Id;
+ Stmt1 : Node_Id;
+ Stmt2 : Node_Id;
+
+ begin
+ Spec := Parent (Proc_Id);
+ Decl := Parent (Spec);
+
+ -- Retrieve the entity of the procedure body (e.g. invariant proc).
+
+ if Nkind (Spec) = N_Procedure_Specification
+ and then Nkind (Decl) = N_Subprogram_Declaration
+ then
+ Body_Id := Corresponding_Body (Decl);
+
+ -- The body acts as a spec
+
+ else
+ Body_Id := Proc_Id;
+ end if;
+
+ -- The body will be generated later
+
+ if No (Body_Id) then
+ return False;
+ end if;
+
+ Spec := Parent (Body_Id);
+ Decl := Parent (Spec);
+
+ pragma Assert
+ (Nkind (Spec) = N_Procedure_Specification
+ and then Nkind (Decl) = N_Subprogram_Body);
+
+ Stmt1 := First (Statements (Handled_Statement_Sequence (Decl)));
+
+ -- Look for a null statement followed by an optional return
+ -- statement.
+
+ if Nkind (Stmt1) = N_Null_Statement then
+ Stmt2 := Next (Stmt1);
+
+ if Present (Stmt2) then
+ return Nkind (Stmt2) = N_Simple_Return_Statement;
+ else
+ return True;
+ end if;
+ end if;
+
+ return False;
+ end Has_Null_Body;
+
------------------------
-- Has_Null_Exclusion --
------------------------
===================================================================
@@ -1103,6 +1103,11 @@
-- as expressed in pragma Refined_State. This function does not take into
-- account the visible refinement region of abstract state Id.
+ function Has_Null_Body (Proc_Id : Entity_Id) return Boolean;
+ -- Determine whether the body of procedure Proc_Id contains a sole
+ -- null statement, possibly followed by an optional return. Used to
+ -- optimize useless calls to assertion checks.
+
function Has_Null_Exclusion (N : Node_Id) return Boolean;
-- Determine whether node N has a null exclusion
===================================================================
@@ -1452,73 +1452,10 @@
-------------------------
function Invariant_Checks_OK (Typ : Entity_Id) return Boolean is
- function Has_Null_Body (Proc_Id : Entity_Id) return Boolean;
- -- Determine whether the body of procedure Proc_Id contains a sole
- -- null statement, possibly followed by an optional return.
-
function Has_Public_Visibility_Of_Subprogram return Boolean;
-- Determine whether type Typ has public visibility of subprogram
-- Subp_Id.
- -------------------
- -- Has_Null_Body --
- -------------------
-
- function Has_Null_Body (Proc_Id : Entity_Id) return Boolean is
- Body_Id : Entity_Id;
- Decl : Node_Id;
- Spec : Node_Id;
- Stmt1 : Node_Id;
- Stmt2 : Node_Id;
-
- begin
- Spec := Parent (Proc_Id);
- Decl := Parent (Spec);
-
- -- Retrieve the entity of the invariant procedure body
-
- if Nkind (Spec) = N_Procedure_Specification
- and then Nkind (Decl) = N_Subprogram_Declaration
- then
- Body_Id := Corresponding_Body (Decl);
-
- -- The body acts as a spec
-
- else
- Body_Id := Proc_Id;
- end if;
-
- -- The body will be generated later
-
- if No (Body_Id) then
- return False;
- end if;
-
- Spec := Parent (Body_Id);
- Decl := Parent (Spec);
-
- pragma Assert
- (Nkind (Spec) = N_Procedure_Specification
- and then Nkind (Decl) = N_Subprogram_Body);
-
- Stmt1 := First (Statements (Handled_Statement_Sequence (Decl)));
-
- -- Look for a null statement followed by an optional return
- -- statement.
-
- if Nkind (Stmt1) = N_Null_Statement then
- Stmt2 := Next (Stmt1);
-
- if Present (Stmt2) then
- return Nkind (Stmt2) = N_Simple_Return_Statement;
- else
- return True;
- end if;
- end if;
-
- return False;
- end Has_Null_Body;
-
-----------------------------------------
-- Has_Public_Visibility_Of_Subprogram --
-----------------------------------------
===================================================================
@@ -3714,9 +3714,9 @@
Sel_Comp : Node_Id;
Typ : Entity_Id;
Call : Node_Id;
+ Proc : Entity_Id;
begin
- Invariant_Found := True;
Typ := Etype (Comp);
Sel_Comp :=
@@ -3744,10 +3744,16 @@
-- The aspect is type-specific, so retrieve it from the base type
+ Proc := Invariant_Procedure (Base_Type (Typ));
+
+ if Has_Null_Body (Proc) then
+ return Make_Null_Statement (Loc);
+ end if;
+
+ Invariant_Found := True;
Call :=
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (Invariant_Procedure (Base_Type (Typ)), Loc),
+ Name => New_Occurrence_Of (Proc, Loc),
Parameter_Associations => New_List (Sel_Comp));
if Is_Access_Type (Etype (Comp)) then
This patch removes a redundant call to a generated invariant procedure when Assertion_Policy is ignored. The following must execute quietly: gcc -c -gnatn -O3 -S ut.adb grep "invariant" ut.s --- pragma Assertion_Policy (Ignore); --- private with TI; package UT is type T2 is limited private; procedure Set ( X : in out T2; J : in Integer ); private type T2 is limited record X : TI.T; end record; end; package body UT is procedure Set ( X : in out T2; J : in Integer ) is begin TI.Set (X.X, J); end; end; package TI is type T is limited private; procedure Set ( X : in out T; J : in Integer ); private type T is limited record I : Integer := 0; J : Integer := Integer'Last; end record with Type_Invariant => T.I < T.J; end; package body TI is procedure Set ( X : in out T; J : in Integer ) is begin X.J := J; end; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-06-14 Ed Schonberg <schonberg@adacore.com> * contracts.adb (Has_Null_Body): Move to sem_util, for general availability. * sem_util.ads, sem_util.adb (Has_Null_Body): Predicate to determine when an internal procedure created for some assertion checking (e.g. type invariant) is a null procedure. Used to eliminate redundant calls to such procedures when they apply to components of composite types. * exp_ch3.adb (Build_Component_Invariant_Call): Do not add call if invariant procedure has a null body.