aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Baird <baird@adacore.com>2022-11-10 17:15:33 -0800
committerMarc Poulhiès <poulhies@adacore.com>2022-11-21 11:10:33 +0100
commit76aac607c7eb53313cfd907a31cee6c5e4f550ae (patch)
treebc38894e1583acfe4e6ebf0fb43f51bc164c430e
parent7dcf757a5192d399295736b57d63a73136523bcb (diff)
downloadgcc-76aac607c7eb53313cfd907a31cee6c5e4f550ae.zip
gcc-76aac607c7eb53313cfd907a31cee6c5e4f550ae.tar.gz
gcc-76aac607c7eb53313cfd907a31cee6c5e4f550ae.tar.bz2
ada: Ada 2022 Image attribute bugs
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.
-rw-r--r--gcc/ada/libgnat/a-strsup.adb11
-rw-r--r--gcc/ada/libgnat/a-strsup.ads8
-rw-r--r--gcc/ada/libgnat/a-sttebu.adb3
-rw-r--r--gcc/ada/libgnat/a-stwisu.adb11
-rw-r--r--gcc/ada/libgnat/a-stwisu.ads8
-rw-r--r--gcc/ada/libgnat/a-stzsup.adb11
-rw-r--r--gcc/ada/libgnat/a-stzsup.ads8
7 files changed, 56 insertions, 4 deletions
diff --git a/gcc/ada/libgnat/a-strsup.adb b/gcc/ada/libgnat/a-strsup.adb
index 831a18e..0210b45 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 416fa7b..600f097 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 d992fee..acca292 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 d325676..cf27ca9 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 c22c2a2..7437cbd 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 6153bbe..a4fa996 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 148b972..b50d21a 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