[COMMITTED] ada: Ada 2022 Image attribute bugs

Message ID 20221121101418.259338-1-poulhies@adacore.com
State New
Headers
Series [COMMITTED] ada: Ada 2022 Image attribute bugs |

Commit Message

Marc Poulhiès Nov. 21, 2022, 10:14 a.m. UTC
  From: Steve Baird <baird@adacore.com>

Two issues. First, the two procedures
Ada.Strings.Text_Buffers.Output_Mapping.[Wide_]Wide_Put each correctly
call Encode, but that call was missing from the corresponding Put procedure.
Second, if a record type contains an array-valued Data component as well as
both a Max_Length and Current_Length component, then the slice
Data (Current_Length + 1 .. Max_Length) should usually be treated like
uninitialized data. It should not participate in things like equality
comparisons. In particular, it should not participate in 'Image results.
To accomplish this, such a type usually ought to have a Put_Image aspect
specification. This Put_Image aspect specification was missing for the
three Super_String types declared in the
Ada.Strings.[Wide_[Wide_]]Superbounded packages.

gcc/ada/
	* libgnat/a-sttebu.adb (Put): Add missing call to Encode.
	* libgnat/a-strsup.ads: Declare new Put_Image procedure and add
	Put_Image aspect specification for type Super_String.
	* libgnat/a-strsup.adb (Put_Image): New procedure.
	* libgnat/a-stwisu.ads: Declare new Put_Image procedure and add
	Put_Image aspect specification for type Super_String.
	* libgnat/a-stwisu.adb (Put_Image): New procedure.
	* libgnat/a-stzsup.ads: Declare new Put_Image procedure and add
	Put_Image aspect specification for type Super_String.
	* libgnat/a-stzsup.adb (Put_Image): New procedure.

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

---
 gcc/ada/libgnat/a-strsup.adb | 11 +++++++++++
 gcc/ada/libgnat/a-strsup.ads |  8 +++++++-
 gcc/ada/libgnat/a-sttebu.adb |  3 ++-
 gcc/ada/libgnat/a-stwisu.adb | 11 +++++++++++
 gcc/ada/libgnat/a-stwisu.ads |  8 +++++++-
 gcc/ada/libgnat/a-stzsup.adb | 11 +++++++++++
 gcc/ada/libgnat/a-stzsup.ads |  8 +++++++-
 7 files changed, 56 insertions(+), 4 deletions(-)
  

Patch

diff --git a/gcc/ada/libgnat/a-strsup.adb b/gcc/ada/libgnat/a-strsup.adb
index 831a18e1e19..0210b45c4c7 100644
--- a/gcc/ada/libgnat/a-strsup.adb
+++ b/gcc/ada/libgnat/a-strsup.adb
@@ -303,6 +303,17 @@  package body Ada.Strings.Superbounded with SPARK_Mode is
       return Left <= Super_To_String (Right);
    end Less_Or_Equal;
 
+   ---------------
+   -- Put_Image --
+   ---------------
+
+   procedure Put_Image
+     (S      : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+      Source : Super_String) is
+   begin
+      String'Put_Image (S, Super_To_String (Source));
+   end Put_Image;
+
    ----------------------
    -- Set_Super_String --
    ----------------------
diff --git a/gcc/ada/libgnat/a-strsup.ads b/gcc/ada/libgnat/a-strsup.ads
index 416fa7bb06a..600f097c2bf 100644
--- a/gcc/ada/libgnat/a-strsup.ads
+++ b/gcc/ada/libgnat/a-strsup.ads
@@ -49,6 +49,7 @@  pragma Assertion_Policy (Pre            => Ignore,
 
 with Ada.Strings.Maps; use type Ada.Strings.Maps.Character_Mapping_Function;
 with Ada.Strings.Search;
+with Ada.Strings.Text_Buffers;
 
 package Ada.Strings.Superbounded with SPARK_Mode is
    pragma Preelaborate;
@@ -69,7 +70,8 @@  package Ada.Strings.Superbounded with SPARK_Mode is
    with
      Predicate =>
        Current_Length <= Max_Length
-         and then Data (1 .. Current_Length)'Initialized;
+         and then Data (1 .. Current_Length)'Initialized,
+     Put_Image => Put_Image;
 
    --  The subprograms defined for Super_String are similar to those
    --  defined for Bounded_String, except that they have different names, so
@@ -2695,6 +2697,10 @@  package Ada.Strings.Superbounded with SPARK_Mode is
                        - (Item.Max_Length - K) mod Super_Length (Item)))),
      Global         => null;
 
+   procedure Put_Image
+     (S      : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+      Source : Super_String);
+
 private
       --  Pragma Inline declarations
 
diff --git a/gcc/ada/libgnat/a-sttebu.adb b/gcc/ada/libgnat/a-sttebu.adb
index d992fee9f04..acca2923443 100644
--- a/gcc/ada/libgnat/a-sttebu.adb
+++ b/gcc/ada/libgnat/a-sttebu.adb
@@ -29,6 +29,7 @@ 
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Ada.Strings.UTF_Encoding.Strings;
 with Ada.Strings.UTF_Encoding.Wide_Strings;
 with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
 
@@ -59,7 +60,7 @@  package body Ada.Strings.Text_Buffers is
 
       procedure Put (Buffer : in out Buffer_Type; Item : String) is
       begin
-         Put_UTF_8 (Buffer, Item);
+         Put_UTF_8 (Buffer, UTF_Encoding.Strings.Encode (Item));
       end Put;
 
       procedure Wide_Put (Buffer : in out Buffer_Type; Item : Wide_String) is
diff --git a/gcc/ada/libgnat/a-stwisu.adb b/gcc/ada/libgnat/a-stwisu.adb
index d325676edf9..cf27ca9f190 100644
--- a/gcc/ada/libgnat/a-stwisu.adb
+++ b/gcc/ada/libgnat/a-stwisu.adb
@@ -297,6 +297,17 @@  package body Ada.Strings.Wide_Superbounded is
       return Left <= Right.Data (1 .. Right.Current_Length);
    end Less_Or_Equal;
 
+   ---------------
+   -- Put_Image --
+   ---------------
+
+   procedure Put_Image
+     (S      : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+      Source : Super_String) is
+   begin
+      Wide_String'Put_Image (S, Super_To_String (Source));
+   end Put_Image;
+
    ----------------------
    -- Set_Super_String --
    ----------------------
diff --git a/gcc/ada/libgnat/a-stwisu.ads b/gcc/ada/libgnat/a-stwisu.ads
index c22c2a23850..7437cbda224 100644
--- a/gcc/ada/libgnat/a-stwisu.ads
+++ b/gcc/ada/libgnat/a-stwisu.ads
@@ -37,6 +37,7 @@ 
 --  Strings.Wide_Bounded.Generic_Bounded_Length use this type with
 --  an appropriate discriminant value set.
 
+with Ada.Strings.Text_Buffers;
 with Ada.Strings.Wide_Maps;
 
 package Ada.Strings.Wide_Superbounded is
@@ -54,7 +55,8 @@  package Ada.Strings.Wide_Superbounded is
       --  no longer necessary, because we now special-case this type in the
       --  compiler, so "=" composes properly for descendants of this type.
       --  Leaving it out is more efficient.
-   end record;
+   end record
+   with Put_Image => Put_Image;
 
    --  The subprograms defined for Super_String are similar to those defined
    --  for Bounded_Wide_String, except that they have different names, so that
@@ -477,6 +479,10 @@  package Ada.Strings.Wide_Superbounded is
       Item  : Super_String;
       Drop  : Truncation := Error) return Super_String;
 
+   procedure Put_Image
+     (S      : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+      Source : Super_String);
+
 private
       --  Pragma Inline declarations
 
diff --git a/gcc/ada/libgnat/a-stzsup.adb b/gcc/ada/libgnat/a-stzsup.adb
index 6153bbe392f..a4fa9968bef 100644
--- a/gcc/ada/libgnat/a-stzsup.adb
+++ b/gcc/ada/libgnat/a-stzsup.adb
@@ -297,6 +297,17 @@  package body Ada.Strings.Wide_Wide_Superbounded is
       return Left <= Right.Data (1 .. Right.Current_Length);
    end Less_Or_Equal;
 
+   ---------------
+   -- Put_Image --
+   ---------------
+
+   procedure Put_Image
+     (S      : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+      Source : Super_String) is
+   begin
+      Wide_Wide_String'Put_Image (S, Super_To_String (Source));
+   end Put_Image;
+
    ----------------------
    -- Set_Super_String --
    ----------------------
diff --git a/gcc/ada/libgnat/a-stzsup.ads b/gcc/ada/libgnat/a-stzsup.ads
index 148b972b30d..b50d21ad6ae 100644
--- a/gcc/ada/libgnat/a-stzsup.ads
+++ b/gcc/ada/libgnat/a-stzsup.ads
@@ -37,6 +37,7 @@ 
 --  Strings.Wide_Wide_Bounded.Generic_Bounded_Length use this type with
 --  an appropriate discriminant value set.
 
+with Ada.Strings.Text_Buffers;
 with Ada.Strings.Wide_Wide_Maps;
 
 package Ada.Strings.Wide_Wide_Superbounded is
@@ -55,7 +56,8 @@  package Ada.Strings.Wide_Wide_Superbounded is
       --  no longer necessary, because we now special-case this type in the
       --  compiler, so "=" composes properly for descendants of this type.
       --  Leaving it out is more efficient.
-   end record;
+   end record
+   with Put_Image => Put_Image;
 
    --  The subprograms defined for Super_String are similar to those defined
    --  for Bounded_Wide_Wide_String, except that they have different names, so
@@ -486,6 +488,10 @@  package Ada.Strings.Wide_Wide_Superbounded is
       Item  : Super_String;
       Drop  : Truncation := Error) return Super_String;
 
+   procedure Put_Image
+     (S      : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+      Source : Super_String);
+
 private
       --  Pragma Inline declarations