[gcc r16-1138] ada: Fix New_Char_Array with empty arrays

[Marc Poulhies]

https://gcc.gnu.org/g:ac936aa57ee0b0a867e80233efefa204b2ae2bc7

commit r16-1138-gac936aa57ee0b0a867e80233efefa204b2ae2bc7
Author: Ronan Desplanques <desplanques@adacore.com>
Date:   Thu Jan 16 12:55:37 2025 +0100

    ada: Fix New_Char_Array with empty arrays
    
    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.

Diff:
---
 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 7bf881f87167..6d329254aff3 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;