From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 22 Jul 2019 13:56:55 +0000 (+0000)
Subject: [Ada] Fix wrong assumption on bounds in GNAT.Encode_String
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=52860cc145a7075a9f30840703f96b242cd0150f;p=gcc.git

[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 6fc9d1c59cc..cf8b1711c3f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/ada/libgnat/g-encstr.adb b/gcc/ada/libgnat/g-encstr.adb
index 81a73fd23d4..b115c8af2e8 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 c542c626f1d..6dbdc4360e3 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.
diff --git a/gcc/testsuite/gnat.dg/encode_string1.adb b/gcc/testsuite/gnat.dg/encode_string1.adb
new file mode 100644
index 00000000000..f1144bac4a8
--- /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 00000000000..fa969a059fc
--- /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 00000000000..ba2d675cb05
--- /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);