[COMMITTED,05/31] ada: Put_Image spec incorrectly ignored for Fixed_Point_Type'Base'Image call.

Message ID 20250107125350.619654-5-poulhies@adacore.com
State New
Headers
Series [COMMITTED,01/31] ada: Restrict previous change made to expansion of allocators |

Commit Message

Marc Poulhiès Jan. 7, 2025, 12:53 p.m. UTC
  From: Steve Baird <baird@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_put_image.adb | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)
  

Patch

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index dff9bba55a8..ef4494b7f11 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;