mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 02:10:29 +08:00
Code Issues Packages Projects Releases Wiki Activity

[Ada] Assertions in Einfo.Utils

Browse Source 
Add predicates on subtypes E and N.

gcc/ada/

	* einfo-utils.ads, einfo-utils.adb: Add predicates on subtypes E
	and N.  Change some parameters to use the unpredicated subtypes,
	because they sometimes return e.g. Empty.  Note that N_Entity_Id
	has a predicate; Entity_Id does not.
	* exp_tss.adb (Base_Init_Proc): Use Entity_Id instead of E,
	because otherwise we fail the predicate. We shouldn't be
	referring to single-letter names from far away anyway.
	* sem_aux.adb (Is_Derived_Type): Likewise.
	* sem_res.adb (Is_Definite_Access_Type): Use N_Entity_Id for
	predicate.
	* types.ads (Entity_Id): Add comment explaining the difference
	between Entity_Id and N_Entity_Id.
This commit is contained in:
Bob Duff 2022-05-26 10:27:42 -04:00 committed by Pierre-Marie de Rodat
parent 78f13b008a
commit 4b766285b0
6 changed files with 71 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
gcc/ada/einfo-utils.adb
View File

@ -28,7 +28,6 @@ with Elists; use Elists;
with Nlists; use Nlists;
with Output; use Output;
with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
package body Einfo.Utils is
@ -307,7 +306,7 @@ package body Einfo.Utils is
return Ekind (Id) in Generic_Unit_Kind;
end Is_Generic_Unit;
function Is_Ghost_Entity (Id : Entity_Id) return Boolean is
function Is_Ghost_Entity (Id : E) return Boolean is
begin
return Is_Checked_Ghost_Entity (Id) or else Is_Ignored_Ghost_Entity (Id);
end Is_Ghost_Entity;
@ -593,7 +592,7 @@ package body Einfo.Utils is
-- Address_Clause --
--------------------
function Address_Clause (Id : E) return N is
function Address_Clause (Id : E) return Node_Id is
begin
return Get_Attribute_Definition_Clause (Id, Attribute_Address);
end Address_Clause;
@ -618,7 +617,7 @@ package body Einfo.Utils is
-- Alignment_Clause --
----------------------
function Alignment_Clause (Id : E) return N is
function Alignment_Clause (Id : E) return Node_Id is
begin
return Get_Attribute_Definition_Clause (Id, Attribute_Alignment);
end Alignment_Clause;
@ -672,7 +671,7 @@ package body Einfo.Utils is
-- Declaration_Node --
----------------------
function Declaration_Node (Id : E) return N is
function Declaration_Node (Id : E) return Node_Id is
P : Node_Id;
begin
@ -771,7 +770,7 @@ package body Einfo.Utils is
-- First_Component --
---------------------
function First_Component (Id : E) return E is
function First_Component (Id : E) return Entity_Id is
Comp_Id : Entity_Id;
begin
@ -793,7 +792,7 @@ package body Einfo.Utils is
-- First_Component_Or_Discriminant --
-------------------------------------
function First_Component_Or_Discriminant (Id : E) return E is
function First_Component_Or_Discriminant (Id : E) return Entity_Id is
Comp_Id : Entity_Id;
begin
@ -816,7 +815,7 @@ package body Einfo.Utils is
-- First_Formal --
------------------
function First_Formal (Id : E) return E is
function First_Formal (Id : E) return Entity_Id is
Formal : Entity_Id;
begin
@ -857,7 +856,7 @@ package body Einfo.Utils is
-- First_Formal_With_Extras --
------------------------------
function First_Formal_With_Extras (Id : E) return E is
function First_Formal_With_Extras (Id : E) return Entity_Id is
Formal : Entity_Id;
begin
@ -1383,7 +1382,7 @@ package body Einfo.Utils is
-- Invariant_Procedure --
-------------------------
function Invariant_Procedure (Id : E) return E is
function Invariant_Procedure (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@ -1525,7 +1524,7 @@ package body Einfo.Utils is
-- Is_Elaboration_Target --
---------------------------
function Is_Elaboration_Target (Id : Entity_Id) return Boolean is
function Is_Elaboration_Target (Id : E) return Boolean is
begin
return
Ekind (Id) in E_Constant | E_Package | E_Variable
@ -1768,7 +1767,7 @@ package body Einfo.Utils is
-- Last_Formal --
-----------------
function Last_Formal (Id : E) return E is
function Last_Formal (Id : E) return Entity_Id is
Formal : Entity_Id;
begin
@ -1911,7 +1910,7 @@ package body Einfo.Utils is
-- Next_Component --
--------------------
function Next_Component (Id : E) return E is
function Next_Component (Id : E) return Entity_Id is
Comp_Id : Entity_Id;
begin
@ -1928,7 +1927,7 @@ package body Einfo.Utils is
-- Next_Component_Or_Discriminant --
------------------------------------
function Next_Component_Or_Discriminant (Id : E) return E is
function Next_Component_Or_Discriminant (Id : E) return Entity_Id is
Comp_Id : Entity_Id;
begin
@ -1949,7 +1948,7 @@ package body Einfo.Utils is
-- Next_Stored_Discriminant by making sure that the Discriminant
-- returned is of the same variety as Id.
function Next_Discriminant (Id : E) return E is
function Next_Discriminant (Id : E) return Entity_Id is
-- Derived Tagged types with private extensions look like this...
@ -1962,7 +1961,7 @@ package body Einfo.Utils is
-- so it is critical not to go past the leading discriminants
D : E := Id;
D : Entity_Id := Id;
begin
pragma Assert (Ekind (Id) = E_Discriminant);
@ -1987,7 +1986,7 @@ package body Einfo.Utils is
-- Next_Formal --
-----------------
function Next_Formal (Id : E) return E is
function Next_Formal (Id : E) return Entity_Id is
P : Entity_Id;
begin
@ -2012,7 +2011,7 @@ package body Einfo.Utils is
-- Next_Formal_With_Extras --
-----------------------------
function Next_Formal_With_Extras (Id : E) return E is
function Next_Formal_With_Extras (Id : E) return Entity_Id is
begin
if Present (Extra_Formal (Id)) then
return Extra_Formal (Id);
@ -2025,7 +2024,7 @@ package body Einfo.Utils is
-- Next_Index --
----------------
function Next_Index (Id : Node_Id) return Node_Id is
function Next_Index (Id : N) return Node_Id is
begin
pragma Assert (Nkind (Id) in N_Is_Index);
pragma Assert (No (Next (Id)) or else Nkind (Next (Id)) in N_Is_Index);
@ -2036,7 +2035,7 @@ package body Einfo.Utils is
-- Next_Literal --
------------------
function Next_Literal (Id : E) return E is
function Next_Literal (Id : E) return Entity_Id is
begin
pragma Assert (Nkind (Id) in N_Entity);
return Next (Id);
@ -2046,7 +2045,7 @@ package body Einfo.Utils is
-- Next_Stored_Discriminant --
------------------------------
function Next_Stored_Discriminant (Id : E) return E is
function Next_Stored_Discriminant (Id : E) return Entity_Id is
begin
-- See comment in Next_Discriminant
@ -2124,7 +2123,7 @@ package body Einfo.Utils is
-- Object_Size_Clause --
------------------------
function Object_Size_Clause (Id : E) return N is
function Object_Size_Clause (Id : E) return Node_Id is
begin
return Get_Attribute_Definition_Clause (Id, Attribute_Object_Size);
end Object_Size_Clause;
@ -2142,7 +2141,7 @@ package body Einfo.Utils is
-- DIC_Procedure --
-------------------
function DIC_Procedure (Id : E) return E is
function DIC_Procedure (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@ -2174,7 +2173,7 @@ package body Einfo.Utils is
return Empty;
end DIC_Procedure;
function Partial_DIC_Procedure (Id : E) return E is
function Partial_DIC_Procedure (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@ -2227,7 +2226,7 @@ package body Einfo.Utils is
-- Partial_Invariant_Procedure --
---------------------------------
function Partial_Invariant_Procedure (Id : E) return E is
function Partial_Invariant_Procedure (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@ -2340,7 +2339,7 @@ package body Einfo.Utils is
-- Predicate_Function --
------------------------
function Predicate_Function (Id : E) return E is
function Predicate_Function (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@ -2835,8 +2834,8 @@ package body Einfo.Utils is
-- Size_Clause --
-----------------
function Size_Clause (Id : E) return N is
Result : N := Get_Attribute_Definition_Clause (Id, Attribute_Size);
function Size_Clause (Id : E) return Node_Id is
Result : Node_Id := Get_Attribute_Definition_Clause (Id, Attribute_Size);
begin
if No (Result) then
Result := Get_Attribute_Definition_Clause (Id, Attribute_Value_Size);
@ -2938,7 +2937,7 @@ package body Einfo.Utils is
-- Type_High_Bound --
---------------------
function Type_High_Bound (Id : E) return Node_Id is
function Type_High_Bound (Id : E) return N is
Rng : constant Node_Id := Scalar_Range (Id);
begin
if Nkind (Rng) = N_Subtype_Indication then
@ -2952,7 +2951,7 @@ package body Einfo.Utils is
-- Type_Low_Bound --
--------------------
function Type_Low_Bound (Id : E) return Node_Id is
function Type_Low_Bound (Id : E) return N is
Rng : constant Node_Id := Scalar_Range (Id);
begin
if Nkind (Rng) = N_Subtype_Indication then
@ -2966,7 +2965,7 @@ package body Einfo.Utils is
-- Underlying_Type --
---------------------
function Underlying_Type (Id : E) return E is
function Underlying_Type (Id : E) return Entity_Id is
begin
-- For record_with_private the underlying type is always the direct full
-- view. Never try to take the full view of the parent it does not make

57
gcc/ada/einfo-utils.ads
View File

@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Einfo.Entities; use Einfo.Entities;
with Sinfo.Nodes; use Sinfo.Nodes;
package Einfo.Utils is
@ -73,14 +74,16 @@ package Einfo.Utils is
-------------------
-- The following type synonyms are used to tidy up the function and
-- procedure declarations that follow.
-- procedure declarations that follow. Note that E and N have predicates
-- ensuring the correct kind; we use Entity_Id or Node_Id when the
-- predicates can't be satisfied.
subtype B is Boolean;
subtype C is Component_Alignment_Kind;
subtype E is Entity_Id;
subtype E is N_Entity_Id;
subtype F is Float_Rep_Kind;
subtype M is Mechanism_Type;
subtype N is Node_Id;
subtype N is Node_Id with Predicate => N /= Empty and then N not in E;
subtype U is Uint;
subtype R is Ureal;
subtype L is Elist_Id;
@ -199,17 +202,17 @@ package Einfo.Utils is
-- The functions in this section synthesize attributes from the tree,
-- so they do not correspond to defined fields in the entity itself.
function Address_Clause (Id : E) return N;
function Address_Clause (Id : E) return Node_Id;
function Aft_Value (Id : E) return U;
function Alignment_Clause (Id : E) return N;
function Alignment_Clause (Id : E) return Node_Id;
function Base_Type (Id : E) return E;
function Declaration_Node (Id : E) return N;
function Declaration_Node (Id : E) return Node_Id;
function Designated_Type (Id : E) return E;
function Entry_Index_Type (Id : E) return E;
function First_Component (Id : E) return E;
function First_Component_Or_Discriminant (Id : E) return E;
function First_Formal (Id : E) return E;
function First_Formal_With_Extras (Id : E) return E;
function First_Component (Id : E) return Entity_Id;
function First_Component_Or_Discriminant (Id : E) return Entity_Id;
function First_Formal (Id : E) return Entity_Id;
function First_Formal_With_Extras (Id : E) return Entity_Id;
function Float_Rep
(N : Entity_Id) return F with Inline, Pre =>
@ -260,7 +263,7 @@ package Einfo.Utils is
function Is_Task_Interface (Id : E) return B;
function Is_Task_Record_Type (Id : E) return B;
function Is_Wrapper_Package (Id : E) return B;
function Last_Formal (Id : E) return E;
function Last_Formal (Id : E) return Entity_Id;
function Machine_Emax_Value (Id : E) return U;
function Machine_Emin_Value (Id : E) return U;
function Machine_Mantissa_Value (Id : E) return U;
@ -269,18 +272,18 @@ package Einfo.Utils is
function Model_Epsilon_Value (Id : E) return R;
function Model_Mantissa_Value (Id : E) return U;
function Model_Small_Value (Id : E) return R;
function Next_Component (Id : E) return E;
function Next_Component_Or_Discriminant (Id : E) return E;
function Next_Discriminant (Id : E) return E;
function Next_Formal (Id : E) return E;
function Next_Formal_With_Extras (Id : E) return E;
function Next_Index (Id : N) return N;
function Next_Literal (Id : E) return E;
function Next_Stored_Discriminant (Id : E) return E;
function Next_Component (Id : E) return Entity_Id;
function Next_Component_Or_Discriminant (Id : E) return Entity_Id;
function Next_Discriminant (Id : E) return Entity_Id;
function Next_Formal (Id : E) return Entity_Id;
function Next_Formal_With_Extras (Id : E) return Entity_Id;
function Next_Index (Id : N) return Node_Id;
function Next_Literal (Id : E) return Entity_Id;
function Next_Stored_Discriminant (Id : E) return Entity_Id;
function Number_Dimensions (Id : E) return Pos;
function Number_Entries (Id : E) return Nat;
function Number_Formals (Id : E) return Pos;
function Object_Size_Clause (Id : E) return N;
function Object_Size_Clause (Id : E) return Node_Id;
function Parameter_Mode (Id : E) return Formal_Kind;
function Partial_Refinement_Constituents (Id : E) return L;
function Primitive_Operations (Id : E) return L;
@ -288,11 +291,11 @@ package Einfo.Utils is
function Safe_Emax_Value (Id : E) return U;
function Safe_First_Value (Id : E) return R;
function Safe_Last_Value (Id : E) return R;
function Size_Clause (Id : E) return N;
function Size_Clause (Id : E) return Node_Id;
function Stream_Size_Clause (Id : E) return N;
function Type_High_Bound (Id : E) return N;
function Type_Low_Bound (Id : E) return N;
function Underlying_Type (Id : E) return E;
function Underlying_Type (Id : E) return Entity_Id;
function Scope_Depth (Id : E) return U;
function Scope_Depth_Set (Id : E) return B;
@ -432,11 +435,11 @@ package Einfo.Utils is
function Is_Partial_DIC_Procedure (Id : E) return B;
function DIC_Procedure (Id : E) return E;
function Partial_DIC_Procedure (Id : E) return E;
function Invariant_Procedure (Id : E) return E;
function Partial_Invariant_Procedure (Id : E) return E;
function Predicate_Function (Id : E) return E;
function DIC_Procedure (Id : E) return Entity_Id;
function Partial_DIC_Procedure (Id : E) return Entity_Id;
function Invariant_Procedure (Id : E) return Entity_Id;
function Partial_Invariant_Procedure (Id : E) return Entity_Id;
function Predicate_Function (Id : E) return Entity_Id;
procedure Set_DIC_Procedure (Id : E; V : E);
procedure Set_Partial_DIC_Procedure (Id : E; V : E);

2
gcc/ada/exp_tss.adb
View File

@ -49,7 +49,7 @@ package body Exp_Tss is
(Typ : Entity_Id;
Ref : Entity_Id := Empty) return Entity_Id
is
Full_Type : E;
Full_Type : Entity_Id;
Proc : Entity_Id;
begin

6
gcc/ada/sem_aux.adb
View File

@ -964,7 +964,7 @@ package body Sem_Aux is
-- Is_Derived_Type --
---------------------
function Is_Derived_Type (Ent : E) return B is
function Is_Derived_Type (Ent : Entity_Id) return B is
Par : Node_Id;
begin
@ -1130,10 +1130,8 @@ package body Sem_Aux is
else
declare
C : E;
C : Entity_Id := First_Component (Btype);
begin
C := First_Component (Btype);
while Present (C) loop
if Is_Limited_Type (Etype (C)) then
return True;

6
gcc/ada/sem_res.adb
View File

@ -144,7 +144,7 @@ package body Sem_Res is
-- returns true if the prefix denotes an atomic object that has an address
-- clause (the case in which we may want to issue a warning).
function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
function Is_Definite_Access_Type (E : N_Entity_Id) return Boolean;
-- Determine whether E is an access type declared by an access declaration,
-- and not an (anonymous) allocator type.
@ -1510,7 +1510,7 @@ package body Sem_Res is
-- Is_Definite_Access_Type --
-----------------------------
function Is_Definite_Access_Type (E : Entity_Id) return Boolean is
function Is_Definite_Access_Type (E : N_Entity_Id) return Boolean is
Btyp : constant Entity_Id := Base_Type (E);
begin
return Ekind (Btyp) = E_Access_Type
@ -1561,7 +1561,7 @@ package body Sem_Res is
Orig_Type : Entity_Id := Empty;
Pack : Entity_Id;
type Kind_Test is access function (E : Entity_Id) return Boolean;
type Kind_Test is access function (E : N_Entity_Id) return Boolean;
function Operand_Type_In_Scope (S : Entity_Id) return Boolean;
-- If the operand is not universal, and the operator is given by an

5
gcc/ada/types.ads
View File

@ -404,6 +404,11 @@ package Types is
-- that are entities (i.e. nodes with an Nkind of N_Defining_xxx). All such
-- nodes are extended nodes and these are the only extended nodes, so that
-- in practice entity and extended nodes are synonymous.
--
-- Note that Sinfo.Nodes.N_Entity_Id is the same as Entity_Id, except it
-- has a predicate requiring the correct Nkind. Opt_N_Entity_Id is the same
-- as N_Entity_Id, except it allows Empty. (Sinfo.Nodes is generated by the
-- Gen_IL program.)
subtype Node_Or_Entity_Id is Node_Id;
-- A synonym for node types, used in cases where a given value may be used