[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:
parent
f3d2fbfdb8
commit
52860cc145
@ -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
|
||||
|
@ -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;
|
||||
|
||||
---------------------------
|
||||
|
@ -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.
|
||||
|
48
gcc/testsuite/gnat.dg/encode_string1.adb
Normal file
48
gcc/testsuite/gnat.dg/encode_string1.adb
Normal 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;
|
15
gcc/testsuite/gnat.dg/encode_string1_pkg.adb
Normal file
15
gcc/testsuite/gnat.dg/encode_string1_pkg.adb
Normal 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;
|
6
gcc/testsuite/gnat.dg/encode_string1_pkg.ads
Normal file
6
gcc/testsuite/gnat.dg/encode_string1_pkg.ads
Normal 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);
|
Loading…
Reference in New Issue
Block a user