From e8bcc47f25e59683194446c45a68442e1702259b Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Tue, 16 Jan 2024 12:55:24 +0100 Subject: ada: Fix detection of components with per-object constraints Routine Contains_POC (where POC means "per-object constraint") was failing to detect expressions of the form "Current_Type'Access", because it was comparing prefix (typically an N_Identifier) with a scope (typically an N_Definining_Entity). This was harmless, because these expressions are detected anyway in Analyze_Access_Attribute, together with uses of 'Unconstrained_Access and 'Unchecked_Access. Also, this routine was failing to detect the use of discriminants in array types with constrained subtype indication, e.g.: type T (D : Integer) is record C : array (Integer range 1 .. D); end record; It is simpler to just reuse Has_Discriminant_Dependent_Constraint and leave detection of access attributes to Analyze_Access_Attribute. gcc/ada/ * sem_attr.adb (Analyze_Access_Attribute): Prevent search from going too far. * sem_ch3.adb (Analyze_Component_Declaration): Remove Contains_POC; reuse Has_Discriminant_Dependent_Constraint. --- gcc/ada/sem_attr.adb | 20 ++++++++------ gcc/ada/sem_ch3.adb | 74 ++-------------------------------------------------- 2 files changed, 14 insertions(+), 80 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index c067d88..c17f673 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1014,16 +1014,20 @@ package body Sem_Attr is Q : Node_Id := Parent (N); begin - while Present (Q) - and then Nkind (Q) /= N_Component_Declaration - loop + while Present (Q) loop + if Nkind (Q) = N_Component_Declaration then + Set_Has_Per_Object_Constraint + (Defining_Identifier (Q), True); + exit; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Q) then + exit; + end if; + Q := Parent (Q); end loop; - - if Present (Q) then - Set_Has_Per_Object_Constraint - (Defining_Identifier (Q), True); - end if; end; if Nkind (P) = N_Expanded_Name then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 737ea80..ad9e931 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1960,71 +1960,11 @@ package body Sem_Ch3 is T : Entity_Id; P : Entity_Id; - function Contains_POC (Constr : Node_Id) return Boolean; - -- Determines whether a constraint uses the discriminant of a record - -- type thus becoming a per-object constraint (POC). - function Is_Known_Limited (Typ : Entity_Id) return Boolean; -- Typ is the type of the current component, check whether this type is -- a limited type. Used to validate declaration against that of -- enclosing record. - ------------------ - -- Contains_POC -- - ------------------ - - function Contains_POC (Constr : Node_Id) return Boolean is - begin - -- Prevent cascaded errors - - if Error_Posted (Constr) then - return False; - end if; - - case Nkind (Constr) is - when N_Attribute_Reference => - return Attribute_Name (Constr) = Name_Access - and then Prefix (Constr) = Scope (Entity (Prefix (Constr))); - - when N_Discriminant_Association => - return Denotes_Discriminant (Expression (Constr)); - - when N_Identifier => - return Denotes_Discriminant (Constr); - - when N_Index_Or_Discriminant_Constraint => - declare - IDC : Node_Id; - - begin - IDC := First (Constraints (Constr)); - while Present (IDC) loop - - -- One per-object constraint is sufficient - - if Contains_POC (IDC) then - return True; - end if; - - Next (IDC); - end loop; - - return False; - end; - - when N_Range => - return Denotes_Discriminant (Low_Bound (Constr)) - or else - Denotes_Discriminant (High_Bound (Constr)); - - when N_Range_Constraint => - return Denotes_Discriminant (Range_Expression (Constr)); - - when others => - return False; - end case; - end Contains_POC; - ---------------------- -- Is_Known_Limited -- ---------------------- @@ -2208,18 +2148,8 @@ package body Sem_Ch3 is -- The component declaration may have a per-object constraint, set -- the appropriate flag in the defining identifier of the subtype. - if Present (Subtype_Indication (Component_Definition (N))) then - declare - Sindic : constant Node_Id := - Subtype_Indication (Component_Definition (N)); - begin - if Nkind (Sindic) = N_Subtype_Indication - and then Present (Constraint (Sindic)) - and then Contains_POC (Constraint (Sindic)) - then - Set_Has_Per_Object_Constraint (Id); - end if; - end; + if Has_Discriminant_Dependent_Constraint (Id) then + Set_Has_Per_Object_Constraint (Id); end if; -- Ada 2005 (AI-231): Propagate the null-excluding attribute and carry -- cgit v1.1