procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[Ada] Suppression of elaboration-related warnings

Browse source 
This patch modifies the effects of pragma Warnings (Off, ...) to suppress
elaboration warnings related to an entity.

2018-05-23  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* einfo.adb (Is_Elaboration_Checks_OK_Id): Use predicate
	Is_Elaboration_Target.
	(Is_Elaboration_Target): New routine.
	(Is_Elaboration_Warnings_OK_Id): Use predicate Is_Elaboration_Target.
	(Set_Is_Elaboration_Checks_OK_Id): Use predicate Is_Elaboration_Target.
	(Set_Is_Elaboration_Warnings_OK_Id): Use predicate
	Is_Elaboration_Target.
	* einfo.ads: Add new synthesized attribute Is_Elaboration_Target along
	with occurrences in nodes.
	(Is_Elaboration_Target): New routine.
	* sem_prag.adb (Analyze_Pragma): Suppress elaboration warnings when an
	elaboration target is subject to pragma Warnings (Off, ...).

gcc/testsuite/

	* gnat.dg/elab5.adb, gnat.dg/elab5_pkg.adb, gnat.dg/elab5_pkg.ads: New
	testcase.

From-SVN: r260580
This commit is contained in:
Hristian Kirtchev 2018-05-23 10:22:25 +00:00 • committed by Pierre-Marie de Rodat
parent 6e6e00ffd2
commit 4868853418
8 changed files with 234 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/ada/ChangeLog
View file

@ -1,3 +1,18 @@
2018-05-23 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb (Is_Elaboration_Checks_OK_Id): Use predicate
Is_Elaboration_Target.
(Is_Elaboration_Target): New routine.
(Is_Elaboration_Warnings_OK_Id): Use predicate Is_Elaboration_Target.
(Set_Is_Elaboration_Checks_OK_Id): Use predicate Is_Elaboration_Target.
(Set_Is_Elaboration_Warnings_OK_Id): Use predicate
Is_Elaboration_Target.
* einfo.ads: Add new synthesized attribute Is_Elaboration_Target along
with occurrences in nodes.
(Is_Elaboration_Target): New routine.
* sem_prag.adb (Analyze_Pragma): Suppress elaboration warnings when an
elaboration target is subject to pragma Warnings (Off, ...).
2018-05-23 Eric Botcazou <ebotcazou@adacore.com>
* repinfo.adb (List_Type_Info): Remove obsolete stuff.

42
gcc/ada/einfo.adb
View file

@ -2253,23 +2253,13 @@ package body Einfo is
function Is_Elaboration_Checks_OK_Id (Id : E) return B is
begin
pragma Assert
(Ekind_In (Id, E_Constant, E_Variable)
or else Is_Entry (Id)
or else Is_Generic_Unit (Id)
or else Is_Subprogram (Id)
or else Is_Task_Type (Id));
pragma Assert (Is_Elaboration_Target (Id));
return Flag148 (Id);
end Is_Elaboration_Checks_OK_Id;
function Is_Elaboration_Warnings_OK_Id (Id : E) return B is
begin
pragma Assert
(Ekind_In (Id, E_Constant, E_Variable, E_Void)
or else Is_Entry (Id)
or else Is_Generic_Unit (Id)
or else Is_Subprogram (Id)
or else Is_Task_Type (Id));
pragma Assert (Is_Elaboration_Target (Id) or else Ekind (Id) = E_Void);
return Flag304 (Id);
end Is_Elaboration_Warnings_OK_Id;
@ -5478,23 +5468,13 @@ package body Einfo is
procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True) is
begin
pragma Assert
(Ekind_In (Id, E_Constant, E_Variable)
or else Is_Entry (Id)
or else Is_Generic_Unit (Id)
or else Is_Subprogram (Id)
or else Is_Task_Type (Id));
pragma Assert (Is_Elaboration_Target (Id));
Set_Flag148 (Id, V);
end Set_Is_Elaboration_Checks_OK_Id;
procedure Set_Is_Elaboration_Warnings_OK_Id (Id : E; V : B := True) is
begin
pragma Assert
(Ekind_In (Id, E_Constant, E_Variable)
or else Is_Entry (Id)
or else Is_Generic_Unit (Id)
or else Is_Subprogram (Id)
or else Is_Task_Type (Id));
pragma Assert (Is_Elaboration_Target (Id));
Set_Flag304 (Id, V);
end Set_Is_Elaboration_Warnings_OK_Id;
@ -8112,6 +8092,20 @@ package body Einfo is
and then Is_Entity_Attribute_Name (Attribute_Name (N)));
end Is_Entity_Name;
---------------------------
-- Is_Elaboration_Target --
---------------------------
function Is_Elaboration_Target (Id : Entity_Id) return Boolean is
begin
return
Ekind_In (Id, E_Constant, E_Variable)
or else Is_Entry (Id)
or else Is_Generic_Unit (Id)
or else Is_Subprogram (Id)
or else Is_Task_Type (Id);
end Is_Elaboration_Target;
-----------------------
-- Is_External_State --
-----------------------

15
gcc/ada/einfo.ads
View file

@ -2522,12 +2522,16 @@ package Einfo is
-- checks. Such targets are allowed to generate run-time conditional ABE
-- checks or guaranteed ABE failures.
-- Is_Elaboration_Target (synthesized)
-- Applies to all entities, True only for elaboration targets (see the
-- terminology in Sem_Elab).
-- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Defined in elaboration targets (see terminology in Sem_Elab). Set when
-- the target appears in a region with elaboration warnings enabled.
-- Is_Elementary_Type (synthesized)
-- Applies to all entities, true for all elementary types and subtypes.
-- Applies to all entities, True for all elementary types and subtypes.
-- Either Is_Composite_Type or Is_Elementary_Type (but not both) is true
-- of any type.
@ -5971,6 +5975,7 @@ package Einfo is
-- Address_Clause (synth)
-- Alignment_Clause (synth)
-- Is_Atomic_Or_VFA (synth)
-- Is_Elaboration_Target (synth)
-- Size_Clause (synth)
-- E_Decimal_Fixed_Point_Type
@ -6041,6 +6046,7 @@ package Einfo is
-- Entry_Index_Type (synth)
-- First_Formal (synth)
-- First_Formal_With_Extras (synth)
-- Is_Elaboration_Target (synth)
-- Last_Formal (synth)
-- Number_Formals (synth)
-- Scope_Depth (synth)
@ -6202,6 +6208,7 @@ package Einfo is
-- Address_Clause (synth)
-- First_Formal (synth)
-- First_Formal_With_Extras (synth)
-- Is_Elaboration_Target (synth)
-- Last_Formal (synth)
-- Number_Formals (synth)
-- Scope_Depth (synth)
@ -6329,6 +6336,7 @@ package Einfo is
-- Is_Primitive (Flag218)
-- Is_Pure (Flag44)
-- SPARK_Pragma_Inherited (Flag265)
-- Is_Elaboration_Target (synth)
-- Aren't there more flags and fields? seems like this list should be
-- more similar to the E_Function list, which is much longer ???
@ -6401,6 +6409,7 @@ package Einfo is
-- Static_Elaboration_Desired (Flag77) (non-generic case only)
-- Has_Non_Null_Abstract_State (synth)
-- Has_Null_Abstract_State (synth)
-- Is_Elaboration_Target (synth)
-- Is_Wrapper_Package (synth) (non-generic case only)
-- Scope_Depth (synth)
@ -6525,6 +6534,7 @@ package Einfo is
-- Address_Clause (synth)
-- First_Formal (synth)
-- First_Formal_With_Extras (synth)
-- Is_Elaboration_Target (synth)
-- Is_Finalizer (synth)
-- Last_Formal (synth)
-- Number_Formals (synth)
@ -6712,6 +6722,7 @@ package Einfo is
-- First_Component (synth)
-- First_Component_Or_Discriminant (synth)
-- Has_Entries (synth)
-- Is_Elaboration_Target (synth)
-- Number_Entries (synth)
-- Scope_Depth (synth)
-- (plus type attributes)
@ -6777,6 +6788,7 @@ package Einfo is
-- Address_Clause (synth)
-- Alignment_Clause (synth)
-- Is_Atomic_Or_VFA (synth)
-- Is_Elaboration_Target (synth)
-- Size_Clause (synth)
-- E_Void
@ -7595,6 +7607,7 @@ package Einfo is
function Is_Controlled (Id : E) return B;
function Is_Discriminal (Id : E) return B;
function Is_Dynamic_Scope (Id : E) return B;
function Is_Elaboration_Target (Id : E) return B;
function Is_External_State (Id : E) return B;
function Is_Finalizer (Id : E) return B;
function Is_Null_State (Id : E) return B;

7
gcc/ada/sem_prag.adb
View file

@ -24696,6 +24696,13 @@ package body Sem_Prag is
(E, (Chars (Get_Pragma_Arg (Arg1)) =
Name_Off));
-- Suppress elaboration warnings if the entity
-- denotes an elaboration target.
if Is_Elaboration_Target (E) then
Set_Is_Elaboration_Warnings_OK_Id (E, False);
end if;
-- For OFF case, make entry in warnings off
-- pragma table for later processing. But we do
-- not do that within an instance, since these

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2018-05-23 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/elab5.adb, gnat.dg/elab5_pkg.adb, gnat.dg/elab5_pkg.ads: New
testcase.
2018-05-23 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/elab4.adb, gnat.dg/elab4_pkg.adb, gnat.dg/elab4_pkg.ads: New

5
gcc/testsuite/gnat.dg/elab5.adb Normal file
View file

@ -0,0 +1,5 @@
-- { dg-do link }
with Elab5_Pkg;
procedure Elab5 is begin null; end Elab5;

123
gcc/testsuite/gnat.dg/elab5_pkg.adb Normal file
View file

@ -0,0 +1,123 @@
with Ada.Text_IO; use Ada.Text_IO;
package body Elab5_Pkg is
--------------------------------------------------
-- Call to call, instantiation, task activation --
--------------------------------------------------
procedure Suppressed_Call_1 is
package Inst is new ABE_Gen;
T : ABE_Task;
begin
ABE_Call;
end Suppressed_Call_1;
function Elaborator_1 return Boolean is
begin
pragma Warnings ("L");
Suppressed_Call_1;
pragma Warnings ("l");
return True;
end Elaborator_1;
Elab_1 : constant Boolean := Elaborator_1;
procedure Suppressed_Call_2 is
package Inst is new ABE_Gen;
T : ABE_Task;
begin
ABE_Call;
end Suppressed_Call_2;
function Elaborator_2 return Boolean is
begin
Suppressed_Call_2;
return True;
end Elaborator_2;
Elab_2 : constant Boolean := Elaborator_2;
procedure Suppressed_Call_3 is
package Inst is new ABE_Gen;
T : ABE_Task;
begin
ABE_Call;
end Suppressed_Call_3;
function Elaborator_3 return Boolean is
begin
Suppressed_Call_3;
return True;
end Elaborator_3;
Elab_3 : constant Boolean := Elaborator_3;
-----------------------------------------------------------
-- Instantiation to call, instantiation, task activation --
-----------------------------------------------------------
package body Suppressed_Generic is
procedure Force_Body is begin null; end Force_Body;
package Inst is new ABE_Gen;
T : ABE_Task;
begin
ABE_Call;
end Suppressed_Generic;
function Elaborator_4 return Boolean is
pragma Warnings ("L");
package Inst is new Suppressed_Generic;
pragma Warnings ("l");
begin
return True;
end Elaborator_4;
Elab_4 : constant Boolean := Elaborator_4;
-------------------------------------------------------------
-- Task activation to call, instantiation, task activation --
-------------------------------------------------------------
task body Suppressed_Task is
package Inst is new ABE_Gen;
T : ABE_Task;
begin
ABE_Call;
end Suppressed_Task;
function Elaborator_5 return Boolean is
pragma Warnings ("L");
T : Suppressed_Task;
pragma Warnings ("l");
begin
return True;
end Elaborator_5;
Elab_5 : constant Boolean := Elaborator_5;
function Elaborator_6 return Boolean is
T : Suppressed_Task;
pragma Warnings (Off, T);
begin
return True;
end Elaborator_6;
Elab_6 : constant Boolean := Elaborator_6;
procedure ABE_Call is
begin
Put_Line ("ABE_Call");
end ABE_Call;
package body ABE_Gen is
procedure Force_Body is begin null; end Force_Body;
begin
Put_Line ("ABE_Gen");
end ABE_Gen;
task body ABE_Task is
begin
Put_Line ("ABE_Task");
end ABE_Task;
end Elab5_Pkg;

47
gcc/testsuite/gnat.dg/elab5_pkg.ads Normal file
View file

@ -0,0 +1,47 @@
package Elab5_Pkg is
procedure ABE_Call;
generic
package ABE_Gen is
procedure Force_Body;
end ABE_Gen;
task type ABE_Task;
--------------------------------------------------
-- Call to call, instantiation, task activation --
--------------------------------------------------
function Elaborator_1 return Boolean;
function Elaborator_2 return Boolean;
function Elaborator_3 return Boolean;
procedure Suppressed_Call_1;
pragma Warnings ("L");
procedure Suppressed_Call_2;
pragma Warnings ("l");
procedure Suppressed_Call_3;
pragma Warnings (Off, Suppressed_Call_3);
-----------------------------------------------------------
-- Instantiation to call, instantiation, task activation --
-----------------------------------------------------------
function Elaborator_4 return Boolean;
generic
package Suppressed_Generic is
procedure Force_Body;
end Suppressed_Generic;
-------------------------------------------------------------
-- Task activation to call, instantiation, task activation --
-------------------------------------------------------------
function Elaborator_5 return Boolean;
function Elaborator_6 return Boolean;
task type Suppressed_Task;
end Elab5_Pkg;