[Ada] Use pragma Unsuppress in Time_IO
authorBob Duff <duff@adacore.com>
Tue, 12 May 2020 15:07:36 +0000 (11:07 -0400)
committerPierre-Marie de Rodat <derodat@adacore.com>
Tue, 7 Jul 2020 09:26:56 +0000 (05:26 -0400)
gcc/ada/

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

gcc/ada/libgnat/g-catiio.adb

index ad1babfb8261487d21699b5524806b91a70761cb..cd2df6a438b33b7cbba46aae0b3772e5cdc62a14 100644 (file)
@@ -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;