diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2019-07-22 13:56:55 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-22 13:56:55 +0000 |
commit | 52860cc145a7075a9f30840703f96b242cd0150f (patch) | |
tree | d2c89e2e6587d36af6c2b95c94a23dbeb3c04cc5 | |
parent | f3d2fbfdb83bcc60d72824daf7a470c0e5398854 (diff) | |
download | gcc-52860cc145a7075a9f30840703f96b242cd0150f.zip gcc-52860cc145a7075a9f30840703f96b242cd0150f.tar.gz gcc-52860cc145a7075a9f30840703f96b242cd0150f.tar.bz2 |
[Ada] Fix wrong assumption on bounds in GNAT.Encode_String
This fixes a couple of oversights in the GNAT.Encode_String package,
whose effect is to assume that all the strings have a lower bound of 1.
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* libgnat/g-encstr.adb (Encode_Wide_String): Fix oversight.
(Encode_Wide_Wide_String): Likewise.
gcc/testsuite/
* gnat.dg/encode_string1.adb, gnat.dg/encode_string1_pkg.adb,
gnat.dg/encode_string1_pkg.ads: New testcase.
From-SVN: r273674
-rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/libgnat/g-encstr.adb | 8 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/encode_string1.adb | 48 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/encode_string1_pkg.adb | 15 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/encode_string1_pkg.ads | 6 |
6 files changed, 83 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6fc9d1c..cf8b171 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-07-22 Eric Botcazou <ebotcazou@adacore.com> + * libgnat/g-encstr.adb (Encode_Wide_String): Fix oversight. + (Encode_Wide_Wide_String): Likewise. + +2019-07-22 Eric Botcazou <ebotcazou@adacore.com> + * sem_warn.adb (Find_Var): Bail out for a function call with an Out or In/Out parameter. diff --git a/gcc/ada/libgnat/g-encstr.adb b/gcc/ada/libgnat/g-encstr.adb index 81a73fd..b115c8a 100644 --- a/gcc/ada/libgnat/g-encstr.adb +++ b/gcc/ada/libgnat/g-encstr.adb @@ -79,12 +79,12 @@ package body GNAT.Encode_String is Ptr : Natural; begin - Ptr := S'First; + Ptr := Result'First; for J in S'Range loop Encode_Wide_Character (S (J), Result, Ptr); end loop; - Length := Ptr - S'First; + Length := Ptr - Result'First; end Encode_Wide_String; ----------------------------- @@ -108,12 +108,12 @@ package body GNAT.Encode_String is Ptr : Natural; begin - Ptr := S'First; + Ptr := Result'First; for J in S'Range loop Encode_Wide_Wide_Character (S (J), Result, Ptr); end loop; - Length := Ptr - S'First; + Length := Ptr - Result'First; end Encode_Wide_Wide_String; --------------------------- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c542c62..6dbdc43 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2019-07-22 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/encode_string1.adb, gnat.dg/encode_string1_pkg.adb, + gnat.dg/encode_string1_pkg.ads: New testcase. + +2019-07-22 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/warn23.adb: New testcase. 2019-07-22 Javier Miranda <miranda@adacore.com> diff --git a/gcc/testsuite/gnat.dg/encode_string1.adb b/gcc/testsuite/gnat.dg/encode_string1.adb new file mode 100644 index 0000000..f1144ba --- /dev/null +++ b/gcc/testsuite/gnat.dg/encode_string1.adb @@ -0,0 +1,48 @@ +-- { dg-do run } + +with Ada.Text_IO; use Ada.Text_IO; +with Encode_String1_Pkg; +with GNAT.Encode_String; +with System.WCh_Con; use System.WCh_Con; + +procedure Encode_String1 is + High_WS : constant Wide_String (1000 .. 1009) := (others => '1'); + High_WWS : constant Wide_Wide_String (1000 .. 1009) := (others => '2'); + Low_WS : constant Wide_String (3 .. 12) := (others => '3'); + Low_WWS : constant Wide_Wide_String (3 .. 12) := (others => '4'); + + procedure Test_Method (Method : WC_Encoding_Method); + -- Test Wide_String and Wide_Wide_String encodings using method Method to + -- encode them. + + ----------------- + -- Test_Method -- + ----------------- + + procedure Test_Method (Method : WC_Encoding_Method) is + package Encoder is new GNAT.Encode_String (Method); + + procedure WS_Tester is new Encode_String1_Pkg + (C => Wide_Character, + S => Wide_String, + Encode => Encoder.Encode_Wide_String); + + procedure WWS_Tester is new Encode_String1_Pkg + (C => Wide_Wide_Character, + S => Wide_Wide_String, + Encode => Encoder.Encode_Wide_Wide_String); + begin + WS_Tester (High_WS); + WS_Tester (Low_WS); + + WWS_Tester (High_WWS); + WWS_Tester (Low_WWS); + end Test_Method; + +-- Start of processing for Main + +begin + for Method in WC_Encoding_Method'Range loop + Test_Method (Method); + end loop; +end; diff --git a/gcc/testsuite/gnat.dg/encode_string1_pkg.adb b/gcc/testsuite/gnat.dg/encode_string1_pkg.adb new file mode 100644 index 0000000..fa969a0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/encode_string1_pkg.adb @@ -0,0 +1,15 @@ +with Ada.Exceptions; use Ada.Exceptions; +with Ada.Text_IO; use Ada.Text_IO; + +procedure Encode_String1_Pkg (Val : S) is +begin + declare + Result : constant String := Encode (Val); + begin + Put_Line (Result); + end; + +exception + when Ex : others => + Put_Line ("ERROR: Unexpected exception " & Exception_Name (Ex)); +end; diff --git a/gcc/testsuite/gnat.dg/encode_string1_pkg.ads b/gcc/testsuite/gnat.dg/encode_string1_pkg.ads new file mode 100644 index 0000000..ba2d675 --- /dev/null +++ b/gcc/testsuite/gnat.dg/encode_string1_pkg.ads @@ -0,0 +1,6 @@ +generic + type C is private; + type S is array (Positive range <>) of C; + with function Encode (Val : S) return String; + +procedure Encode_String1_Pkg (Val : S); |