https://gcc.gnu.org/g:67e3db712e36e15486709ea39759a53f15c3d0e6
commit r15-6623-g67e3db712e36e15486709ea39759a53f15c3d0e6
Author: Steve Baird <ba...@adacore.com>
Date: Thu Dec 12 17:06:00 2024 -0800
ada: Put_Image spec incorrectly ignored for Fixed_Point_Type'Base'Image
call.
If a Put_Image aspect specification (introduced in Ada 2022) is given for a
fixed point type Fx, then in some cases a call to Fx'Base'Image would
incorrectly ignore the aspect specification and would instead return the
pre-Ada2022 version of the image. However, a call to Fx'Image would do the
right thing.
gcc/ada/ChangeLog:
* exp_put_image.adb (Image_Should_Call_Put_Image): Cope with the
case
where the attribute prefix for an Image attribute reference
denotes an Itype constructed for a fixed point type. Calling
Has_Aspect with such an Itype misses applicable aspect
specifications; we need to look on the right list. This comes up
if the prefix of the attribute reference is
Some_Fixed_Point_Type'Base.
Diff:
---
gcc/ada/exp_put_image.adb | 21 +++++++++++++++++++--
1 file changed, 19 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index dff9bba55a85..ef4494b7f112 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -1176,11 +1176,28 @@ package body Exp_Put_Image is
declare
U_Type : constant Entity_Id := Underlying_Type (Entity (Prefix (N)));
begin
- if Has_Aspect (U_Type, Aspect_Put_Image) then
+ if Has_Aspect (U_Type, Aspect_Put_Image)
+ or else not Is_Scalar_Type (U_Type)
+ then
+ return True;
+ end if;
+
+ -- Deal with Itypes. One case where this is needed is for a
+ -- fixed-point type with a Put_Image aspect specification.
+
+ -- ??? Should we be checking for Itype case here, or in Has_Aspect?
+ -- In other words, do we want to do what we are doing here for all
+ -- aspects, not just for Put_Image?
+
+ if Is_Itype (U_Type)
+ and then Has_Aspect (Defining_Identifier
+ (Associated_Node_For_Itype (U_Type)),
+ Aspect_Put_Image)
+ then
return True;
end if;
- return not Is_Scalar_Type (U_Type);
+ return False;
end;
end Image_Should_Call_Put_Image;
