[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6fc9d1c..cf8b171 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
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);