diff options
author | Steve Baird <baird@adacore.com> | 2022-11-10 17:15:33 -0800 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2022-11-21 11:10:33 +0100 |
commit | 76aac607c7eb53313cfd907a31cee6c5e4f550ae (patch) | |
tree | bc38894e1583acfe4e6ebf0fb43f51bc164c430e | |
parent | 7dcf757a5192d399295736b57d63a73136523bcb (diff) | |
download | gcc-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.adb | 11 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-strsup.ads | 8 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-sttebu.adb | 3 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-stwisu.adb | 11 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-stwisu.ads | 8 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-stzsup.adb | 11 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-stzsup.ads | 8 |
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 |