Commit 5b42c035 by Arnaud Charlet

[multiple changes]

2016-10-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Add new usage for Elist29 and Node35.
	(Anonymous_Designated_Type): New routine.
	(Anonymous_Master): Removed.
	(Anonymous_Masters): New routine.
	(Set_Anonymous_Designated_Type): New routine.
	(Set_Anonymous_Master): Removed.
	(Set_Anonymous_Masters): New routine.
	(Write_Field29_Name): Add output for Anonymous_Masters.
	(Write_Field35_Name): Remove the output for Anonymous_Master. Add
	output for Anonymous_Designated_Type.
	* einfo.ads Remove attribute Anonymous_Master along with
	usage in entities. Add attributes Anonymous_Designated_Type
	and Anonymous_Masters along with usage in entities.
	(Anonymous_Designated_Type): New routine along with pragma Inline.
	(Anonymous_Master): Removed along with pragma Inline.
	(Anonymous_Masters): New routine along with pragma Inline.
	(Set_Anonymous_Designated_Type): New routine along with pragma Inline.
	(Set_Anonymous_Master): Removed along with pragma Inline.
	(Set_Anonymous_Masters): New routine along with pragma Inline.
	* exp_ch7.adb (Build_Anonymous_Master): Reuse an anonymous master
	defined in the same unit if it services the same designated
	type, otherwise create a new one.
	(Create_Anonymous_Master): Reimplemented.
	(Current_Anonymous_Master): New routine.
	(In_Subtree): Removed.

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Dynamic_Predicate):
	Check properly whether there is an explicit assertion policy
	for predicate checking, even in the presence of a general Ignore
	assertion policy.

2016-10-12  Steve Baird  <baird@adacore.com>

	* sem.adb (Walk_Library_Items): Cope with ignored ghost units.

From-SVN: r241049
parent d89ce432
2016-10-12 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb Add new usage for Elist29 and Node35.
(Anonymous_Designated_Type): New routine.
(Anonymous_Master): Removed.
(Anonymous_Masters): New routine.
(Set_Anonymous_Designated_Type): New routine.
(Set_Anonymous_Master): Removed.
(Set_Anonymous_Masters): New routine.
(Write_Field29_Name): Add output for Anonymous_Masters.
(Write_Field35_Name): Remove the output for Anonymous_Master. Add
output for Anonymous_Designated_Type.
* einfo.ads Remove attribute Anonymous_Master along with
usage in entities. Add attributes Anonymous_Designated_Type
and Anonymous_Masters along with usage in entities.
(Anonymous_Designated_Type): New routine along with pragma Inline.
(Anonymous_Master): Removed along with pragma Inline.
(Anonymous_Masters): New routine along with pragma Inline.
(Set_Anonymous_Designated_Type): New routine along with pragma Inline.
(Set_Anonymous_Master): Removed along with pragma Inline.
(Set_Anonymous_Masters): New routine along with pragma Inline.
* exp_ch7.adb (Build_Anonymous_Master): Reuse an anonymous master
defined in the same unit if it services the same designated
type, otherwise create a new one.
(Create_Anonymous_Master): Reimplemented.
(Current_Anonymous_Master): New routine.
(In_Subtree): Removed.
2016-10-12 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Dynamic_Predicate):
Check properly whether there is an explicit assertion policy
for predicate checking, even in the presence of a general Ignore
assertion policy.
2016-10-12 Steve Baird <baird@adacore.com>
* sem.adb (Walk_Library_Items): Cope with ignored ghost units.
2016-10-12 Ed Schonberg <schonberg@adacore.com>
* lib-writ.adb (Write_ALI): Removal of unused file entries from
......
......@@ -244,6 +244,7 @@ package body Einfo is
-- Relative_Deadline_Variable Node28
-- Underlying_Record_View Node28
-- Anonymous_Masters Elist29
-- BIP_Initialization_Call Node29
-- Subprograms_For_Type Elist29
......@@ -265,7 +266,7 @@ package body Einfo is
-- Contract Node34
-- Anonymous_Master Node35
-- Anonymous_Designated_Type Node35
-- Import_Pragma Node35
-- Class_Wide_Preconds List38
......@@ -766,11 +767,20 @@ package body Einfo is
return Uint14 (Id);
end Alignment;
function Anonymous_Master (Id : E) return E is
function Anonymous_Designated_Type (Id : E) return E is
begin
pragma Assert (Is_Type (Id));
pragma Assert (Ekind (Id) = E_Variable);
return Node35 (Id);
end Anonymous_Master;
end Anonymous_Designated_Type;
function Anonymous_Masters (Id : E) return L is
begin
pragma Assert (Ekind_In (Id, E_Function,
E_Package,
E_Procedure,
E_Subprogram_Body));
return Elist29 (Id);
end Anonymous_Masters;
function Anonymous_Object (Id : E) return E is
begin
......@@ -3726,11 +3736,20 @@ package body Einfo is
Set_Elist16 (Id, V);
end Set_Access_Disp_Table;
procedure Set_Anonymous_Master (Id : E; V : E) is
procedure Set_Anonymous_Designated_Type (Id : E; V : E) is
begin
pragma Assert (Is_Type (Id));
pragma Assert (Ekind (Id) = E_Variable);
Set_Node35 (Id, V);
end Set_Anonymous_Master;
end Set_Anonymous_Designated_Type;
procedure Set_Anonymous_Masters (Id : E; V : L) is
begin
pragma Assert (Ekind_In (Id, E_Function,
E_Package,
E_Procedure,
E_Subprogram_Body));
Set_Elist29 (Id, V);
end Set_Anonymous_Masters;
procedure Set_Anonymous_Object (Id : E; V : E) is
begin
......@@ -10503,6 +10522,12 @@ package body Einfo is
procedure Write_Field29_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
when E_Function |
E_Package |
E_Procedure |
E_Subprogram_Body =>
Write_Str ("Anonymous_Masters");
when E_Constant |
E_Variable =>
Write_Str ("BIP_Initialization_Call");
......@@ -10650,8 +10675,8 @@ package body Einfo is
procedure Write_Field35_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
when Type_Kind =>
Write_Str ("Anonymous_Master");
when E_Variable =>
Write_Str ("Anonymous_Designated_Type");
when Subprogram_Kind =>
Write_Str ("Import_Pragma");
......
......@@ -438,11 +438,15 @@ package Einfo is
-- definition clause with an (obsolescent) mod clause is converted
-- into an attribute definition clause for this purpose.
-- Anonymous_Master (Node35)
-- Defined in all types. Contains the entity of an anonymous finalization
-- master which services all anonymous access types associated with the
-- same designated type within the current semantic unit. The attribute
-- is set reactively during the expansion of allocators.
-- Anonymous_Designated_Type (Node35)
-- Defined in variables which represent anonymous finalization masters.
-- Contains the designated type which is being services by the master.
-- Anonymous_Masters (Elist29)
-- Defined in packages, subprograms, and subprogram bodies. Contains a
-- list of anonymous finalization masters declared within the related
-- unit. The list acts as a mapping between a master and a designated
-- type.
-- Anonymous_Object (Node30)
-- Present in protected and task type entities. Contains the entity of
......@@ -5530,7 +5534,6 @@ package Einfo is
-- Derived_Type_Link (Node31)
-- No_Tagged_Streams_Pragma (Node32)
-- Linker_Section_Pragma (Node33)
-- Anonymous_Master (Node35)
-- Depends_On_Private (Flag14)
-- Disable_Controlled (Flag253)
......@@ -5982,6 +5985,7 @@ package Einfo is
-- Overridden_Operation (Node26)
-- Wrapped_Entity (Node27) (non-generic case only)
-- Extra_Formals (Node28)
-- Anonymous_Masters (Elist29) (non-generic case only)
-- Corresponding_Equality (Node30) (implicit /= only)
-- Thunk_Entity (Node31) (thunk case only)
-- Corresponding_Procedure (Node32) (generate C code only)
......@@ -6207,6 +6211,7 @@ package Einfo is
-- Package_Instantiation (Node26)
-- Current_Use_Clause (Node27)
-- Finalizer (Node28) (non-generic case only)
-- Anonymous_Masters (Elist29) (non-generic case only)
-- Contract (Node34)
-- SPARK_Pragma (Node40)
-- SPARK_Aux_Pragma (Node41)
......@@ -6292,6 +6297,7 @@ package Einfo is
-- Overridden_Operation (Node26) (never for init proc)
-- Wrapped_Entity (Node27) (non-generic case only)
-- Extra_Formals (Node28)
-- Anonymous_Masters (Elist29) (non-generic case only)
-- Static_Initialization (Node30) (init_proc only)
-- Thunk_Entity (Node31) (thunk case only)
-- Corresponding_Function (Node32) (generate C code only)
......@@ -6483,6 +6489,7 @@ package Einfo is
-- Last_Entity (Node20)
-- Scope_Depth_Value (Uint22)
-- Extra_Formals (Node28)
-- Anonymous_Masters (Elist29)
-- Contract (Node34)
-- SPARK_Pragma (Node40)
-- Contains_Ignored_Ghost_Code (Flag279)
......@@ -6564,6 +6571,7 @@ package Einfo is
-- Encapsulating_State (Node32)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Anonymous_Designated_Type (Node35)
-- SPARK_Pragma (Node40)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
......@@ -6837,7 +6845,8 @@ package Einfo is
function Address_Taken (Id : E) return B;
function Alias (Id : E) return E;
function Alignment (Id : E) return U;
function Anonymous_Master (Id : E) return E;
function Anonymous_Designated_Type (Id : E) return E;
function Anonymous_Masters (Id : E) return L;
function Anonymous_Object (Id : E) return E;
function Associated_Entity (Id : E) return E;
function Associated_Formal_Package (Id : E) return E;
......@@ -7516,7 +7525,8 @@ package Einfo is
procedure Set_Address_Taken (Id : E; V : B := True);
procedure Set_Alias (Id : E; V : E);
procedure Set_Alignment (Id : E; V : U);
procedure Set_Anonymous_Master (Id : E; V : E);
procedure Set_Anonymous_Designated_Type (Id : E; V : E);
procedure Set_Anonymous_Masters (Id : E; V : L);
procedure Set_Anonymous_Object (Id : E; V : E);
procedure Set_Associated_Entity (Id : E; V : E);
procedure Set_Associated_Formal_Package (Id : E; V : E);
......@@ -8314,7 +8324,8 @@ package Einfo is
pragma Inline (Address_Taken);
pragma Inline (Alias);
pragma Inline (Alignment);
pragma Inline (Anonymous_Master);
pragma Inline (Anonymous_Designated_Type);
pragma Inline (Anonymous_Masters);
pragma Inline (Anonymous_Object);
pragma Inline (Associated_Entity);
pragma Inline (Associated_Formal_Package);
......@@ -8832,7 +8843,8 @@ package Einfo is
pragma Inline (Set_Address_Taken);
pragma Inline (Set_Alias);
pragma Inline (Set_Alignment);
pragma Inline (Set_Anonymous_Master);
pragma Inline (Set_Anonymous_Designated_Type);
pragma Inline (Set_Anonymous_Masters);
pragma Inline (Set_Anonymous_Object);
pragma Inline (Set_Associated_Entity);
pragma Inline (Set_Associated_Formal_Package);
......
......@@ -1767,6 +1767,11 @@ package body Sem is
pragma Assert (False, "subunit");
null;
when N_Null_Statement =>
pragma Assert (Is_Ignored_Ghost_Node (Original_Node (Item)));
-- Do not call Action for an ignored ghost unit
return;
when others =>
pragma Assert (False);
null;
......@@ -2095,6 +2100,11 @@ package body Sem is
-- happen when the body of a parent depends on some other
-- descendant.
when N_Null_Statement =>
-- Ignore an ignored ghost unit
pragma Assert (Is_Ignored_Ghost_Node (Original_Node (N)));
null;
when others =>
Par := Scope (Defining_Entity (Unit (CU)));
......
......@@ -19136,15 +19136,17 @@ package body Sem_Prag is
-- the rep item chain, for processing when the type is frozen.
-- This is accomplished by a call to Rep_Item_Too_Late. We also
-- mark the type as having predicates.
-- If the current policy is Ignore mark the subtype accordingly.
-- In the case of predicates we consider them enabled unless an
-- Ignore is specified, to preserve existing warnings.
-- If the current policy for predicate checking is Ignore mark the
-- subtype accordingly. In the case of predicates we consider them
-- enabled unless Ignore is specified (either directly or with a
-- general Assertion_Policy pragma) to preserve existing warnings.
Set_Has_Predicates (Typ);
Set_Predicates_Ignored (Typ,
Present (Check_Policy_List)
and then
Policy_In_Effect (Name_Assertion_Policy) = Name_Ignore);
Policy_In_Effect (Name_Dynamic_Predicate) = Name_Ignore);
Discard := Rep_Item_Too_Late (Typ, N, FOnly => True);
end Predicate;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment