public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-1439] [Ada] Assertions in Einfo.Utils Date: Mon, 4 Jul 2022 07:51:18 +0000 (GMT) [thread overview] Message-ID: <20220704075118.DCE97385087F@sourceware.org> (raw) https://gcc.gnu.org/g:4b766285b089ba1bce91a7644b9d97836e80cda3 commit r13-1439-g4b766285b089ba1bce91a7644b9d97836e80cda3 Author: Bob Duff <duff@adacore.com> Date: Thu May 26 10:27:42 2022 -0400 [Ada] Assertions in Einfo.Utils 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. Diff: --- gcc/ada/einfo-utils.adb | 61 ++++++++++++++++++++++++------------------------- gcc/ada/einfo-utils.ads | 57 +++++++++++++++++++++++---------------------- gcc/ada/exp_tss.adb | 2 +- gcc/ada/sem_aux.adb | 6 ++--- gcc/ada/sem_res.adb | 6 ++--- gcc/ada/types.ads | 5 ++++ 6 files changed, 71 insertions(+), 66 deletions(-) diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index 5e778b127f6..27531f49cd3 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -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 diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads index d830c8da259..beaf1bfcb96 100644 --- a/gcc/ada/einfo-utils.ads +++ b/gcc/ada/einfo-utils.ads @@ -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); diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index a5d94608be4..09bb133a41f 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.adb @@ -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 diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 43c33b45928..ca74d743b40 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index fd1615d9a25..650b7d502c3 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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 diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 3b226e178fa..9ae17974a4d 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -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
reply other threads:[~2022-07-04 7:51 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20220704075118.DCE97385087F@sourceware.org \ --to=pmderodat@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).