From: Ronan Desplanques <desplanq...@adacore.com>
This patch fixes an integer underflow issue on calls of the form
New_Char_Array (X) with X'Last < X'First - 2. That integer underflow
caused attempts at allocating impossibly large amount of memory in some
cases.
gcc/ada/ChangeLog:
* libgnat/i-cstrin.adb (Position_Of_Nul): Change specification and
adjust body accordingly.
(New_Char_Array): Fix size of allocation.
(To_Chars_Ptr): Adapt to Position_Of_Nul change.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnat/i-cstrin.adb | 62 ++++++++++++++++++++----------------
1 file changed, 35 insertions(+), 27 deletions(-)
diff --git a/gcc/ada/libgnat/i-cstrin.adb b/gcc/ada/libgnat/i-cstrin.adb
index 7bf881f8716..6d329254aff 100644
--- a/gcc/ada/libgnat/i-cstrin.adb
+++ b/gcc/ada/libgnat/i-cstrin.adb
@@ -66,8 +66,11 @@ is
pragma Inline ("+");
-- Address arithmetic on chars_ptr value
- function Position_Of_Nul (Into : char_array) return size_t;
- -- Returns position of the first Nul in Into or Into'Last + 1 if none
+ procedure Position_Of_Nul
+ (Into : char_array; Found : out Boolean; Index : out size_t);
+ -- If into contains a Nul character, Found is set to True and Index
+ -- contains the position of the first Nul character in Into. Otherwise
+ -- Found is set to False and the value of Index is not meaningful.
-- We can't use directly System.Memory because the categorization is not
-- compatible, so we directly import here the malloc and free routines.
@@ -107,6 +110,7 @@ is
--------------------
function New_Char_Array (Chars : char_array) return chars_ptr is
+ Found : Boolean;
Index : size_t;
Pointer : chars_ptr;
@@ -114,24 +118,25 @@ is
-- Get index of position of null. If Index > Chars'Last,
-- nul is absent and must be added explicitly.
- Index := Position_Of_Nul (Into => Chars);
- Pointer := Memory_Alloc ((Index - Chars'First + 1));
+ Position_Of_Nul (Into => Chars, Found => Found, Index => Index);
-- If nul is present, transfer string up to and including nul
- if Index <= Chars'Last then
- Update (Item => Pointer,
- Offset => 0,
- Chars => Chars (Chars'First .. Index),
- Check => False);
+ if Found then
+ Pointer := Memory_Alloc (Index - Chars'First + 1);
+
+ Update
+ (Item => Pointer,
+ Offset => 0,
+ Chars => Chars (Chars'First .. Index),
+ Check => False);
else
-- If original string has no nul, transfer whole string and add
-- terminator explicitly.
- Update (Item => Pointer,
- Offset => 0,
- Chars => Chars,
- Check => False);
+ Pointer := Memory_Alloc (Chars'Length + 1);
+
+ Update (Item => Pointer, Offset => 0, Chars => Chars, Check => False);
Poke (nul, Into => Pointer + size_t'(Chars'Length));
end if;
@@ -187,19 +192,19 @@ is
-- Position_Of_Nul --
---------------------
- function Position_Of_Nul (Into : char_array) return size_t is
+ procedure Position_Of_Nul
+ (Into : char_array; Found : out Boolean; Index : out size_t) is
begin
- pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
- "early returns for performance");
+ Found := False;
+ Index := 0;
+
for J in Into'Range loop
if Into (J) = nul then
- return J;
+ Found := True;
+ Index := J;
+ return;
end if;
end loop;
-
- return Into'Last + 1;
-
- pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end Position_Of_Nul;
------------
@@ -231,19 +236,22 @@ is
(Item : char_array_access;
Nul_Check : Boolean := False) return chars_ptr
is
+ Found : Boolean;
+ Index : size_t;
begin
pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
"early returns for performance");
if Item = null then
return Null_Ptr;
- elsif Nul_Check
- and then Position_Of_Nul (Into => Item.all) > Item'Last
- then
- raise Terminator_Error;
- else
- return To_chars_ptr (Item (Item'First)'Address);
+ elsif Nul_Check then
+ Position_Of_Nul (Item.all, Found, Index);
+ if not Found then
+ raise Terminator_Error;
+ end if;
end if;
+ return To_chars_ptr (Item (Item'First)'Address);
+
pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end To_Chars_Ptr;
--
2.43.0
