From 7f0942424b7229797dfbcb7b9467c788df8c26b0 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 28 Sep 2020 05:16:44 -0400 Subject: [PATCH] [Ada] Implement Big_Integer.From_String fully gcc/ada/ * libgnat/a-nbnbin.adb (From_String): Implement fully. --- gcc/ada/libgnat/a-nbnbin.adb | 187 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 186 insertions(+), 1 deletion(-) diff --git a/gcc/ada/libgnat/a-nbnbin.adb b/gcc/ada/libgnat/a-nbnbin.adb index 70df2c2..e40be35 100644 --- a/gcc/ada/libgnat/a-nbnbin.adb +++ b/gcc/ada/libgnat/a-nbnbin.adb @@ -236,11 +236,196 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is ----------------- function From_String (Arg : String) return Big_Integer is + procedure Scan_Decimal + (Arg : String; J : in out Natural; Result : out Big_Integer); + -- Scan decimal value starting at Arg (J). Store value in Result if + -- successful, raise Constraint_Error if not. On exit, J points to the + -- first index past the decimal value. + + ------------------ + -- Scan_Decimal -- + ------------------ + + procedure Scan_Decimal + (Arg : String; J : in out Natural; Result : out Big_Integer) + is + Initial_J : constant Natural := J; + Ten : constant Big_Integer := To_Big_Integer (10); + begin + Result := To_Big_Integer (0); + + while J <= Arg'Last loop + if Arg (J) in '0' .. '9' then + Result := + Result * Ten + To_Big_Integer (Character'Pos (Arg (J)) + - Character'Pos ('0')); + + elsif Arg (J) = '_' then + if J in Initial_J | Arg'Last + or else Arg (J - 1) not in '0' .. '9' + or else Arg (J + 1) not in '0' .. '9' + then + raise Constraint_Error with "invalid integer value: " & Arg; + end if; + else + exit; + end if; + + J := J + 1; + end loop; + end Scan_Decimal; + Result : Big_Integer; + begin - -- ??? only support Long_Long_Long_Integer, good enough for now + -- First try the fast path via Long_Long_Long_Integer'Value + Set_Bignum (Result, To_Bignum (Long_Long_Long_Integer'Value (Arg))); return Result; + + exception + when Constraint_Error => + -- Then try the slow path + + declare + Neg : Boolean := False; + Base_Found : Boolean := False; + Base_Int : Positive := 10; + J : Natural := Arg'First; + Val : Natural; + Base : Big_Integer; + Exp : Big_Integer; + + begin + -- Scan past leading blanks + + while J <= Arg'Last and then Arg (J) = ' ' loop + J := J + 1; + end loop; + + if J > Arg'Last then + raise; + end if; + + -- Scan and store negative sign if found + + if Arg (J) = '-' then + Neg := True; + J := J + 1; + end if; + + -- Scan decimal value: either the result itself, or the base + -- value if followed by a '#'. + + Scan_Decimal (Arg, J, Result); + + -- Scan explicit base if requested + + if J <= Arg'Last and then Arg (J) = '#' then + Base_Int := To_Integer (Result); + + if Base_Int not in 2 .. 16 then + raise; + end if; + + Base_Found := True; + Base := Result; + Result := To_Big_Integer (0); + J := J + 1; + + while J <= Arg'Last loop + case Arg (J) is + when '0' .. '9' => + Val := Character'Pos (Arg (J)) - Character'Pos ('0'); + + if Val >= Base_Int then + raise; + end if; + + Result := Result * Base + To_Big_Integer (Val); + + when 'a' .. 'f' => + Val := + 10 + Character'Pos (Arg (J)) - Character'Pos ('a'); + + if Val >= Base_Int then + raise; + end if; + + Result := Result * Base + To_Big_Integer (Val); + + when 'A' .. 'F' => + Val := + 10 + Character'Pos (Arg (J)) - Character'Pos ('A'); + + if Val >= Base_Int then + raise; + end if; + + Result := Result * Base + To_Big_Integer (Val); + + when '_' => + + -- We only allow _ preceded and followed by a valid + -- number and not any other character. + + if J in Arg'First | Arg'Last + or else Arg (J - 1) in '_' | '#' + or else Arg (J + 1) = '#' + then + raise; + end if; + + when '#' => + J := J + 1; + exit; + + when others => + raise; + end case; + + J := J + 1; + end loop; + else + Base := To_Big_Integer (10); + end if; + + if Base_Found and then Arg (J - 1) /= '#' then + raise; + end if; + + if J <= Arg'Last then + + -- Scan exponent + + if Arg (J) in 'e' | 'E' then + J := J + 1; + + if Arg (J) = '+' then + J := J + 1; + end if; + + Scan_Decimal (Arg, J, Exp); + Result := Result * (Base ** To_Integer (Exp)); + end if; + + -- Scan past trailing blanks + + while J <= Arg'Last and then Arg (J) = ' ' loop + J := J + 1; + end loop; + + if J <= Arg'Last then + raise; + end if; + end if; + + if Neg then + return -Result; + else + return Result; + end if; + end; end From_String; --------------- -- 2.7.4