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.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-07-22  Eric Botcazou  <ebotca...@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.
--- gcc/ada/libgnat/g-encstr.adb
+++ 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;
 
    ---------------------------

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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);

Reply via email to