https://gcc.gnu.org/g:8d25e228915d43fc0c005a1e3864de1017ce7fa5
commit r15-5243-g8d25e228915d43fc0c005a1e3864de1017ce7fa5
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Fri Nov 1 20:47:57 2024 +0100
ada: Fix spurious warning on representation clause for private
discriminated type
This is the warning enabled by -gnatw.h for holes in record types that are
declared with a representation clause for their components.
When a discriminated type has a private declaration that also declares its
discriminants, the sibling discriminants present on the full declaration
are essentially ignored and, therefore, cannot be used in the computation
performed to give the warning.
gcc/ada/ChangeLog:
* sem_ch13.adb (Record_Hole_Check): Deal consistently with the base
type throughout the processing. Return if its declaration is not a
full type declaration. Assert that its record definition is either
a derived type definition or a record definition. If the type has a
private declaration that does not specify unknown discriminants, use
it as the source of discriminant specifications, if any.
(Check_Component_List): Process every N_Discriminant_Specification
but assert that its defining identifier is really a discriminant.
Diff:
---
gcc/ada/sem_ch13.adb | 93 +++++++++++++++++++++++++++++++++-------------------
1 file changed, 59 insertions(+), 34 deletions(-)
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 11545771030e..3597bceb3cce 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12153,7 +12153,7 @@ package body Sem_Ch13 is
-- Checks for gaps in the given Rectype. Compute After_Last, the bit
-- number after the last component. Warn is True on the initial call,
-- and warnings are given for gaps. For a type extension, this is called
- -- recursively to compute After_Last for the parent type; in this case
+ -- recursively to compute After_Last on the parent subtype; in this case
-- Warn is False and the warnings are suppressed.
procedure Component_Order_Check (Rectype : Entity_Id);
@@ -12326,8 +12326,11 @@ package body Sem_Ch13 is
procedure Record_Hole_Check
(Rectype : Entity_Id; After_Last : out Uint; Warn : Boolean)
is
- Decl : constant Node_Id := Declaration_Node (Base_Type (Rectype));
- -- Full declaration of record type
+ Base_Typ : constant Entity_Id := Base_Type (Rectype);
+ -- Base type of record type
+
+ Decl : constant Node_Id := Declaration_Node (Base_Typ);
+ -- Full declaration of base type of record type
procedure Check_Component_List
(DS : List_Id;
@@ -12422,15 +12425,12 @@ package body Sem_Ch13 is
Citem := First (DS);
while Present (Citem) loop
if Nkind (Citem) = N_Discriminant_Specification then
- declare
- Ent : constant Entity_Id :=
- Defining_Identifier (Citem);
- begin
- if Ekind (Ent) = E_Discriminant then
- Ncomps := Ncomps + 1;
- Comps (Ncomps) := Ent;
- end if;
- end;
+ Ncomps := Ncomps + 1;
+ Comps (Ncomps) := Defining_Identifier (Citem);
+
+ -- Check that we pick discriminants from the proper view
+
+ pragma Assert (Ekind (Comps (Ncomps)) = E_Discriminant);
end if;
Next (Citem);
@@ -12507,46 +12507,71 @@ package body Sem_Ch13 is
-- Local variables
- Sbit : Uint;
- -- Starting bit for call to Check_Component_List. Zero for an
- -- untagged type. The size of the Tag for a nonderived tagged
- -- type. Parent size for a type extension.
+ Decl_For_Discriminants : Node_Id;
+ -- Declaration node for the view that provides discriminants
Record_Definition : Node_Id;
-- Record_Definition containing Component_List to pass to
-- Check_Component_List.
+ Sbit : Uint;
+ -- Starting bit for call to Check_Component_List. Zero for an
+ -- untagged type. The size of the Tag for a nonderived tagged
+ -- type. Parent size for a type extension.
+
-- Start of processing for Record_Hole_Check
begin
- if Is_Tagged_Type (Rectype) then
+ -- The tag is not present in the list of components of a tagged type
+
+ if Is_Tagged_Type (Base_Typ) then
Sbit := UI_From_Int (System_Address_Size);
else
Sbit := Uint_0;
end if;
- After_Last := Uint_0;
+ After_Last := Sbit;
+
+ -- We need the full declaration of the base type of the record type
- if Nkind (Decl) = N_Full_Type_Declaration then
- Record_Definition := Type_Definition (Decl);
+ if Nkind (Decl) /= N_Full_Type_Declaration then
+ return;
+ end if;
- -- If we have a record extension, set Sbit to point after the last
- -- component of the parent type, by calling Record_Hole_Check
- -- recursively.
+ Record_Definition := Type_Definition (Decl);
- if Nkind (Record_Definition) = N_Derived_Type_Definition then
- Record_Definition := Record_Extension_Part (Record_Definition);
- Record_Hole_Check (Underlying_Type (Parent_Subtype (Rectype)),
- After_Last => Sbit, Warn => False);
- end if;
+ -- If we have a record extension, set Sbit to point after the last
+ -- component of the parent subtype, by calling Record_Hole_Check
+ -- recursively on this parent subtype.
- if Nkind (Record_Definition) = N_Record_Definition then
- Check_Component_List
- (Discriminant_Specifications (Decl),
- Component_List (Record_Definition),
- Sbit, After_Last);
- end if;
+ if Nkind (Record_Definition) = N_Derived_Type_Definition then
+ Record_Definition := Record_Extension_Part (Record_Definition);
+ Record_Hole_Check
+ (Underlying_Type (Parent_Subtype (Base_Typ)),
+ After_Last => Sbit,
+ Warn => False);
end if;
+
+ pragma Assert (Nkind (Record_Definition) = N_Record_Definition);
+
+ -- If the type has a private declaration that does not specify
+ -- unknown discriminants, this declaration provides the (known)
+ -- discriminants, if any.
+
+ if Has_Private_Declaration (Base_Typ)
+ and then not Partial_View_Has_Unknown_Discr (Base_Typ)
+ then
+ Decl_For_Discriminants :=
+ Declaration_Node (Incomplete_Or_Partial_View (Base_Typ));
+ else
+ Decl_For_Discriminants := Decl;
+ end if;
+
+ Check_Component_List
+ (Discriminant_Specifications (Decl_For_Discriminants),
+ Component_List (Record_Definition),
+ Sbit => Sbit,
+ Abit => After_Last);
end Record_Hole_Check;
-- Start of processing for Check_Record_Representation_Clause
