[Ada] Use pragma Unsuppress in Time_IO

Message ID 20200707092736.GA41542@adacore.com
State New
Headers show
Series
  • [Ada] Use pragma Unsuppress in Time_IO
Related show

Commit Message

Pierre-Marie de Rodat July 7, 2020, 9:27 a.m.
We are relying on language-defined checks (like slice out of bounds) to
detect certain cases of incorrect syntax in time strings.  But the
run-time system is usually compiled with checks suppressed, so this is
erroneous.

We were doing something like:

    X := T'Value (A (Lo .. Hi));
    -- Could be out of bounds, or not digits
    ...
    if not X'Valid then
       raise ...

That 'Valid happened to work in some cases, but it's technically too
late; execution is erroneous before we get there. Also, X could happen
to be valid, even though it's uninitialized, in which case we would get
a wrong Time value.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* libgnat/g-catiio.adb (Value, Parse_ISO_8601): Unsuppress
	checks, and don't rely on 'Valid.

Patch

diff --git a/gcc/ada/libgnat/g-catiio.adb b/gcc/ada/libgnat/g-catiio.adb
--- a/gcc/ada/libgnat/g-catiio.adb
+++ b/gcc/ada/libgnat/g-catiio.adb
@@ -654,6 +654,12 @@  package body GNAT.Calendar.Time_IO is
        Time    : out Ada.Calendar.Time;
        Success : out Boolean)
    is
+      pragma Unsuppress (All_Checks);
+      --  This is necessary because the run-time library is usually compiled
+      --  with checks suppressed, and we are relying on constraint checks in
+      --  this code to catch syntax errors in the Date string (e.g. out of
+      --  bounds slices).
+
       Index : Positive := Date'First;
       --  The current character scan index. After a call to Advance, Index
       --  points to the next character.
@@ -1021,7 +1027,10 @@  package body GNAT.Calendar.Time_IO is
       Success := True;
 
    exception
-      when Wrong_Syntax =>
+      when Wrong_Syntax | Constraint_Error =>
+         --  If constraint check fails, we want to behave the same as
+         --  Wrong_Syntax; we want the caller (Value) to try other
+         --  allowed syntaxes.
          Time :=
            Time_Of (Year_Number'First, Month_Number'First, Day_Number'First);
          Success := False;
@@ -1032,6 +1041,8 @@  package body GNAT.Calendar.Time_IO is
    -----------
 
    function Value (Date : String) return Ada.Calendar.Time is
+      pragma Unsuppress (All_Checks); -- see comment in Parse_ISO_8601
+
       D          : String (1 .. 21);
       D_Length   : constant Natural := Date'Length;
 
@@ -1281,18 +1292,6 @@  package body GNAT.Calendar.Time_IO is
          Extract_Time (1, Hour, Minute, Second, Check_Space => False);
       end if;
 
-      --  Sanity checks
-
-      if not Year'Valid
-        or else not Month'Valid
-        or else not Day'Valid
-        or else not Hour'Valid
-        or else not Minute'Valid
-        or else not Second'Valid
-      then
-         raise Constraint_Error;
-      end if;
-
       return Time_Of (Year, Month, Day, Hour, Minute, Second);
    end Value;