[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
This commit is contained in:
Eric Botcazou 2019-07-22 13:56:55 +00:00 committed by Pierre-Marie de Rodat
parent f3d2fbfdb8
commit 52860cc145
6 changed files with 83 additions and 4 deletions

View File

@ -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

View File

@ -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;
---------------------------

View File

@ -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.

View File

@ -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;

View File

@ -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;

View File

@ -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);