Natools

Artifact [2310ce4bce]
Login

Artifact 2310ce4bceef9b8690b0e8d37e0c600a6a31bbf7:


------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Calendar.Arithmetic;
with Ada.Calendar.Formatting;
with Ada.Calendar.Time_Zones;
with Natools.Time_IO.Human;
with Natools.Time_IO.RFC_3339;

package body Natools.Time_IO.Tests is

   use type Ada.Calendar.Time;
   use type Ada.Calendar.Time_Zones.Time_Offset;

   type Extended_Time is record
      Time : Ada.Calendar.Time;
      Offset : Ada.Calendar.Time_Zones.Time_Offset;
   end record;


   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Explicit_Sign (Image : String) return String
     is (if Image'Length > 0 and then Image (Image'First) = ' '
         then '+' & Image (Image'First + 1 .. Image'Last)
         else Image);

   function Has_Leap_Second_Support return Boolean;

   function Image (Time : Extended_Time) return String
     is ('[' & Ada.Calendar.Formatting.Image (Time.Time) & "] "
      & Explicit_Sign
         (Ada.Calendar.Time_Zones.Time_Offset'Image (Time.Offset)));

   function Quote (Original : String) return String
     is ('"' & Original & '"');


   procedure Check is new NT.Generic_Check (Extended_Time);

   procedure Check is new NT.Generic_Check (String, "=", Quote);


   function Has_Leap_Second_Support return Boolean is
      Leap_Second_Time : Ada.Calendar.Time;
      Year : Ada.Calendar.Year_Number;
      Month : Ada.Calendar.Month_Number;
      Day : Ada.Calendar.Day_Number;
      Hour : Ada.Calendar.Formatting.Hour_Number;
      Minute : Ada.Calendar.Formatting.Minute_Number;
      Second : Ada.Calendar.Formatting.Second_Number;
      Sub_Second : Ada.Calendar.Formatting.Second_Duration;
      Is_Leap_Second : Boolean;
   begin
      begin
         Leap_Second_Time := Ada.Calendar.Formatting.Time_Of
           (1990, 12, 31, 23, 59, 59, 0.25, True, 0);
      exception
         when Ada.Calendar.Time_Error =>
            --  Leap second are explicitly not supported
            return False;
      end;

      Ada.Calendar.Formatting.Split
        (Leap_Second_Time,
         Year, Month, Day,
         Hour, Minute, Second, Sub_Second,
         Is_Leap_Second,
         Time_Zone => 0);

      --  Check that Time_Of/Split at least work on the normal part

      pragma Assert (Year = 1990);
      pragma Assert (Month = 12);
      pragma Assert (Day = 31);
      pragma Assert (Hour = 23);
      pragma Assert (Minute = 59);
      pragma Assert (Second = 59);
      pragma Assert (Sub_Second = 0.25);

      --  According to the standard, Is_Leap_Second should be True at this
      --  point, because Time_Error should have been raised if leap second is
      --  not supported.
      --  However some implementations mistakenly drop silently Leap_Second,
      --  so actual support is determined here by check Is_Leap_Second.

      return Is_Leap_Second;
   end Has_Leap_Second_Support;



   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Human_Duration (Report);
      Human_Time_Difference (Report);
      Read_From_RFC_3339 (Report);
      Write_As_RFC_3339 (Report);
   end All_Tests;



   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Human_Duration (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Human-readable time intervals");

      function Compose
        (Second : Ada.Calendar.Formatting.Second_Number;
         Minute : Ada.Calendar.Formatting.Minute_Number := 0;
         Hour : Ada.Calendar.Formatting.Hour_Number := 0)
        return Duration
        is (Second * 1.0 + Minute * 60.0 + Hour * 3600.0);
   begin
      Check (Test, "-1d", Human.Image (-86400.0), "-1d");
      Check (Test, "0s", Human.Image (0.0), "0");
      Check (Test, "1d", Human.Image (86400.0), "1d");
      Check (Test, "1d", Human.Image (Compose (1, 30, 23)), "23h 30m 1s");
      Check (Test, "23h", Human.Image (Compose (59, 29, 23)), "23h 29m 59s");
      Check (Test, "15h", Human.Image (Compose (0, 20, 15)), "15h 20m");
      Check (Test, "10h", Human.Image (Compose (0, 0, 10)), "10h");
      Check (Test, "10h", Human.Image (Compose (31, 59, 9)), "9h 59m 31s");
      Check (Test, "9h 59m", Human.Image (Compose (29, 59, 9)), "9h 59m 29s");
      Check (Test, "2h", Human.Image (Compose (45, 59, 1)), "1h 59m 45s");
      Check (Test, "1h 2m", Human.Image (Compose (45, 1, 1)), "1h 1m 45s");
      Check (Test, "1h", Human.Image (Compose (31, 59)), "59m 31s");
      Check (Test, "59 min", Human.Image (Compose (28, 59)), "59m 28s");
      Check (Test, "10 min", Human.Image (600.1), "10m 0.1s");
      Check (Test, "10 min", Human.Image (599.7), "9m 59.7s");
      Check (Test, "9 min 59s", Human.Image (599.4), "9m 59.4s");
      Check (Test, "1 min", Human.Image (60.4), "1m 0.4s");
      Check (Test, "1 min", Human.Image (59.6), "59.6s");
      Check (Test, "59s", Human.Image (59.4), "59.4s");
      Check (Test, "10s", Human.Image (10.3), "10.3s");
      Check (Test, "6 s", Human.Image (6.0), "6s");
      Check (Test, "5.400 s", Human.Image (5.4), "5.4s");
      Check (Test, "1 s", Human.Image (1.0), "1s");
      Check (Test, "980 ms", Human.Image (0.98), "980ms");
      Check (Test, "40 ms", Human.Image (0.04), "40ms");
      Check (Test, "20 ms", Human.Image (0.02), "20ms");

      pragma Warnings (Off, "condition is always *");

      if 89999.0 in Duration then
         Check (Test, "1d 1h", Human.Image (89999.0), "1d 59m 59s");
      end if;

      --  The tests below require a smaller Duration'Small than what is
      --  guaranteed by the standard. Further conditions should be added
      --  to prevent a check from failing because of lack of Duration precision

      Check (Test, "2 s", Human.Image (2.0002), "2.0002s");
      Check (Test, "2 s", Human.Image (1.9997), "1.9997s");
      Check (Test, "1.999 s", Human.Image (1.999), "1.999s");
      Check (Test, "1 s", Human.Image (1.0), "1s");
      Check (Test, "999 ms", Human.Image (0.999), "999 ms");
      Check (Test, "2 s", Human.Image (2.000_4), "2.0004");
      Check (Test, "10 ms", Human.Image (0.0104), "10.4 ms");
      Check (Test, "9.990 ms", Human.Image (0.009_99), "9.990 ms");
      Check (Test, "1.001 ms", Human.Image (0.001_001), "1.001 ms");
      Check (Test, "1 ms", Human.Image (0.001), "1.000 ms");
      Check (Test, "999 us", Human.Image (0.000_999), "999 us");
      Check (Test, "10 us", Human.Image (0.000_01), "10 us");
      Check (Test, "9.500 us", Human.Image (0.000_009_5), "9.5 us");
      Check (Test, "1.100 us", Human.Image (0.000_001_1), "1.1 us");
      Check (Test, "1 us", Human.Image (0.000_001), "1 us");
      Check (Test, "900 ns", Human.Image (0.000_000_9), "900 ns");

      pragma Warnings (On, "condition is always *");

   exception
      when Error : others => Test.Report_Exception (Error);
   end Human_Duration;


   procedure Human_Time_Difference (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Human-readable time differences");
      Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;

      function Add
        (Base : Ada.Calendar.Time;
         Days : Ada.Calendar.Arithmetic.Day_Count;
         Seconds : Duration)
        return Ada.Calendar.Time
        is (Ada.Calendar."+"
              (Ada.Calendar.Arithmetic."+" (Base, Days), Seconds));

      function Test_Image
        (Days : Ada.Calendar.Arithmetic.Day_Count;
         Seconds : Duration;
         Use_Weeks : Boolean)
        return String
        is (Human.Difference_Image (Add (Now, Days, Seconds), Now, Use_Weeks));
   begin
      Check (Test, "-1d", Human.Difference_Image (Now, Add (Now, 1, 900.0)));
      Check (Test, "71d", Test_Image (71, 36_000.0, False));
      Check (Test, "10w", Test_Image (70, 3_600.0, True));
      Check (Test, "5w 1d", Test_Image (35, 60_000.0, True));
      Check (Test, "1w 2d", Test_Image (8, 54_000.0, True));
      Check (Test, "8d 15h", Test_Image (8, 54_000.0, False));
      Check (Test, "8d", Test_Image (7, 23 * 3600.0 + 35 * 60.0, False));
      Check (Test, "5d", Test_Image (5, 900.0, True));
      Check (Test, "10h", Test_Image (0, 36_598.0, True));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Human_Time_Difference;


   procedure Read_From_RFC_3339 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("RFC-3339 -> Ada.Calendar.Time");
      Now : constant Extended_Time
        := (Ada.Calendar.Clock, Ada.Calendar.Time_Zones.UTC_Time_Offset);

      function Value (Img : String) return Extended_Time;

      function Value (Img : String) return Extended_Time is
         Result : Extended_Time;
      begin
         RFC_3339.Value (Img, Result.Time, Result.Offset);
         return Result;
      end Value;
   begin
      Check (Test,
         (Ada.Calendar.Formatting.Time_Of
           (1985, 04, 12, 23, 20, 50, 0.52, False, 0), 0),
         Value ("1985-04-12T23:20:50.52Z"),
         "[1] UTC time with subseconds:");

      Check (Test,
         (Ada.Calendar.Formatting.Time_Of
           (1996, 12, 19, 16, 39, 57, 0.0, False, -8 * 60), -8 * 60),
         Value ("1996-12-19T16:39:57-08:00"),
         "[2] Time with negative offset:");

      if Has_Leap_Second_Support then
         Check (Test,
            (Ada.Calendar.Formatting.Time_Of
              (1990, 12, 31, 23, 59, 59, 0.0, True, 0), 0),
            Value ("1990-12-31T23:59:60Z"),
            "[3] UTC leap second:");

         Check (Test,
            (Ada.Calendar.Formatting.Time_Of
              (1990, 12, 31, 15, 59, 59, 0.0, True, -8 * 60), -8 * 60),
            Value ("1990-12-31T15:59:60-08:00"),
            "[4] Leap second with time offset:");
      end if;

      Check (Test,
         (Ada.Calendar.Formatting.Time_Of
           (1937, 01, 01, 12, 0, 27, 0.87, False, 20), 20),
         Value ("1937-01-01T12:00:27.87+00:20"),
         "[5] Noon in the Netherlands:");

      Check (Test, Now,
         Value (RFC_3339.Image (Now.Time, Subsecond_Digits => 9)),
         "[6] Round trip with current time:");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Read_From_RFC_3339;


   procedure Write_As_RFC_3339 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Ada.Calendar.Time -> RFC-3339");
   begin
      Check (Test,
         "1985-04-12T23:20:50.52Z",
         RFC_3339.Image
           (Ada.Calendar.Formatting.Time_Of
              (1985, 04, 12, 23, 20, 50, 0.52, False, 0),
            0, 2),
         "[1] UTC time with subseconds:");

      Check (Test,
         "1996-12-19T16:39:57-08:00",
         RFC_3339.Image
           (Ada.Calendar.Formatting.Time_Of
              (1996, 12, 19, 16, 39, 57, 0.0, False, -8 * 60),
            -8 * 60, 0),
         "[2] Time with negative offset:");

      if Has_Leap_Second_Support then
         Check (Test,
            "1990-12-31T23:59:60Z",
            RFC_3339.Image
              (Ada.Calendar.Formatting.Time_Of
                 (1990, 12, 31, 23, 59, 59, 0.0, True, 0),
               0, 0),
            "[3] UTC leap second:");

         Check (Test,
            "1990-12-31T15:59:60-08:00",
            RFC_3339.Image
              (Ada.Calendar.Formatting.Time_Of
                 (1990, 12, 31, 15, 59, 59, 0.0, True, -8 * 60),
               -8 * 60, 0),
            "[4] Leap second with time offset:");
      end if;

      Check (Test,
         "1937-01-01T12:00:27.87+00:20",
         RFC_3339.Image
           (Ada.Calendar.Formatting.Time_Of
              (1937, 01, 01, 12, 0, 27, 0.87, False, 20),
            20, 2),
         "[5] Noon in the Netherlands:");

      Check (Test,
         "2014-12-25T23:00:00+01:00",
         RFC_3339.Image
           (RFC_3339.Value ("2014-12-25T23:00:00+01:00"),
            60, 0),
         "[6] Round trip");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Write_As_RFC_3339;

end Natools.Time_IO.Tests;