From: Steve Baird <ba...@adacore.com>
If a type T has a partial view with a known_discriminant_part and no
user-specified Put_Image aspect specification, then the output generated
by T'Put_Image would incorrectly omit the discriminant values.
gcc/ada/ChangeLog:
* exp_put_image.adb (Build_Record_Put_Image_Procedure): If
Discriminant_Specifications takes us from the full view of a type
to an (intentionally) unanalyzed subtree, then instead find
discriminant entities by calling Discriminant_Specifications on
the partial view of the type.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_put_image.adb | 55 +++++++++++++++++++++++++++++----------
1 file changed, 41 insertions(+), 14 deletions(-)
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index ae5fa40fa38..40b2a65b821 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -695,17 +695,15 @@ package body Exp_Put_Image is
Put_Image_Base_Type
(Get_Corresponding_Mutably_Tagged_Type_If_Present (Etype (C)));
begin
- if Ekind (C) /= E_Void then
- Append_To (Clist,
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Component_Typ, Loc),
- Attribute_Name => Name_Put_Image,
- Expressions => New_List (
- Make_Identifier (Loc, Name_S),
- Make_Selected_Component (Loc,
- Prefix => Make_Identifier (Loc, Name_V),
- Selector_Name => New_Occurrence_Of (C, Loc)))));
- end if;
+ Append_To (Clist,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Component_Typ, Loc),
+ Attribute_Name => Name_Put_Image,
+ Expressions => New_List (
+ Make_Identifier (Loc, Name_S),
+ Make_Selected_Component (Loc,
+ Prefix => Make_Identifier (Loc, Name_V),
+ Selector_Name => New_Occurrence_Of (C, Loc)))));
end Append_Component_Attr;
-------------------------------
@@ -944,9 +942,38 @@ package body Exp_Put_Image is
-- Generate Put_Images for the discriminants of the type
- Append_List_To (Stms,
- Make_Component_Attributes
- (Discriminant_Specifications (Type_Decl)));
+ declare
+ Discrim_Specs : List_Id := Discriminant_Specifications (Type_Decl);
+ Partial_View : Entity_Id;
+ begin
+ if Present (First (Discrim_Specs))
+ and then Ekind (Defining_Identifier (First (Discrim_Specs))) =
+ E_Void
+ then
+ -- If the known discriminant part is repeated for the
+ -- completion of a private type declaration, then the
+ -- second copy is (by design) not analyzed. So we'd better
+ -- use the first copy instead.
+
+ Partial_View := Incomplete_Or_Partial_View
+ (Defining_Identifier (Type_Decl));
+
+ pragma Assert (Ekind (Partial_View) in
+ E_Private_Type
+ | E_Limited_Private_Type
+ | E_Record_Type_With_Private);
+
+ Discrim_Specs :=
+ Discriminant_Specifications (Parent (Partial_View));
+
+ pragma Assert (Present (First (Discrim_Specs)));
+ pragma Assert
+ (Ekind (Defining_Identifier (First (Discrim_Specs))) /=
+ E_Void);
+ end if;
+
+ Append_List_To (Stms, Make_Component_Attributes (Discrim_Specs));
+ end;
Rdef := Type_Definition (Type_Decl);
--
2.43.0
