[Ada] Suppress call to Initial_Condition when the annotation is ignored

This patch suppresses the generation of the Initial_Condition procedure
tasked with verifying the run-time semantics of the pragma when the
pragma is ignored by means of -gnata, pragma Assertion_Policy, etc.

------------
-- Source --
------------

--  all_asserts_off.adc

pragma Assertion_Policy (Ignore);

--  all_asserts_on.adc

pragma Assertion_Policy (Check);

--  ic_off.adc

pragma Assertion_Policy (Initial_Condition => Ignore);

--  ic_on.adc

pragma Assertion_Policy (Initial_Condition => Check);

--  init_cond.ads

package Init_Cond
  with SPARK_Mode,
       Initial_Condition => Flag = False
is
   Flag : Boolean := True;

   procedure Set_Flag;
end Init_Cond;

--  init_cond.adb

package body Init_Cond
  with SPARK_Mode
is
   procedure Set_Flag is
   begin
      Flag := True;
   end Set_Flag;
end Init_Cond;

----------------------------
-- Compilation and output --
----------------------------

& gcc  -c -S -gnatDG init_cond.adb -gnatec=all_asserts_on.adc
& grep -c "Initial_Condition;" init_cond.adb.dg
& grep -c "_elabb" init_cond.s
& gcc  -c -S -gnatDG init_cond.adb -gnatec=ic_on.adc
& grep -c "Initial_Condition;" init_cond.adb.dg
& grep -c "_elabb" init_cond.s
& gcc  -c -S -gnatDG init_cond.adb -gnatec=all_asserts_off.adc
& grep -c "Initial_Condition;" init_cond.adb.dg
& grep -c "_elabb" init_cond.s
& gcc  -c -S -gnatDG init_cond.adb -gnatec=ic_off.adc
& grep -c "Initial_Condition;" init_cond.adb.dg
& grep -c "_elabb" init_cond.s
2
4
2
4
0
0
0
0

2018-12-11  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_prag.adb (Expand_Pragma_Initial_Condition): Do not
	generate an Initial_Condition procedure and a call to it when
	the associated pragma is ignored.
	* sem_ch10.adb (Analyze_Compilation_Unit): Minor cleanup.

From-SVN: r266977

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b2e6e142ef35ccba8e30a19fcebb8e50e73872b8..9ed28c45c459d40b7d25f0f42c4d465b8638a363 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-12-11  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_prag.adb (Expand_Pragma_Initial_Condition): Do not
+       generate an Initial_Condition procedure and a call to it when
+       the associated pragma is ignored.
+       * sem_ch10.adb (Analyze_Compilation_Unit): Minor cleanup.
+
 2018-12-11  Eric Botcazou  <ebotcazou@adacore.com>
 
        * fe.h (Debug_Generated_Code): Declare.

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 485f066f7023bf88fb38827e6ba9a96b81bcc022..16d32125991560bd8ffbffa09f1ce23c308383e0 100644 (file)
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -1636,10 +1636,16 @@ package body Exp_Prag is
       Expr := Get_Pragma_Arg (First (Pragma_Argument_Associations (IC_Prag)));
       Loc  := Sloc (IC_Prag);
 
+      --  Nothing to do when the pragma is ignored because its semantics are
+      --  suppressed.
+
+      if Is_Ignored (IC_Prag) then
+         return;
+
       --  Nothing to do when the pragma or its argument are illegal because
       --  there is no valid expression to check.
 
-      if Error_Posted (IC_Prag) or else Error_Posted (Expr) then
+      elsif Error_Posted (IC_Prag) or else Error_Posted (Expr) then
          return;
       end if;
 

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index e6d0ba50f4ba19809b4aa3c8f5c881b391119820..10e863f91cc95c5dc0f2a29f11b9f1eadcaed051 100644 (file)
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -1203,8 +1203,6 @@ package body Sem_Ch10 is
             --  binder generated code of all the units involved in a partition
             --  when control-flow preservation is requested.
 
-            --  Case of units which do not require an elaboration entity
-
             if not Opt.Suppress_Control_Flow_Optimizations
               and then
               ( --  Pure units do not need checks
@@ -1232,16 +1230,16 @@ package body Sem_Ch10 is
                 or else Acts_As_Spec (N)
               )
             then
-               --  This is a case where we only need the entity for
-               --  checking to prevent multiple elaboration checks.
+               --  This is a case where we only need the entity for checking to
+               --  prevent multiple elaboration checks.
 
                Set_Elaboration_Entity_Required (Spec_Id, False);
 
-            --  Case of elaboration entity is required for access before
-            --  elaboration checking (so certainly we must build it).
+            --  Otherwise the unit requires an elaboration entity because it
+            --  carries a body.
 
             else
-               Set_Elaboration_Entity_Required (Spec_Id, True);
+               Set_Elaboration_Entity_Required (Spec_Id);
             end if;
 
             Build_Elaboration_Entity (N, Spec_Id);