View Issue Details

IDProjectCategoryView StatusLast Update
0035844FPCRTLpublic2019-07-23 14:55
Reporterrd0xAssigned To 
PrioritynormalSeverityminorReproducibilityN/A
Status newResolutionopen 
Product Version3.3.1Product Build 
Target VersionFixed in Version 
Summary0035844: Support for TTimeSpan record
DescriptionAdd missing TimeSpan unit from Delphi
Additional Informationhttp://docwiki.embarcadero.com/Libraries/Rio/en/System.TimeSpan.TTimeSpan
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files
  • TimeSpan-2.pp (19,715 bytes)
    unit TimeSpan;
    
    {$MODE OBJFPC}
    {$MODESWITCH ADVANCEDRECORDS}
    {$LONGSTRINGS ON}
    
    interface
    
    { Difference from Delphi 10.3 (RIO):
    1. [+] or [-] operator raise EIntOverflow, not EArgumentOutOfRangeException
      Reason: compatible with .NET
    2. Methods FromDays, FromHours, FromMilliseconds, FromMinutes, FromSeconds
      raise EIntOverflow, not EArgumentOutOfRangeException
      Reason: compatible with .NET
    3. Method Parse raise EConvertError, not Exception, when invalid format
      Reason: compatible with .NET
    4. Method Parse raise EArgumentNilException, not Exception for null string
      Reason: compatible with .NET
    5. Method Parse more strict. For example it's reject string '1:0:0.', because
      last dot is invalid. Delphi ignore it.
      Reason: compatible with .NET
    6. Method ToString always prints '-' for negative timespan. Example:
      TTimeSpan.Parse('-1:0:0').ToString show '-01:00:00', but '01:00:00' in Delphi
      Reason: Delphi implementation error
    }
    
    uses SysUtils;
    
    type
      TTimeSpan = record
      strict private
        FTicks: Int64;
        function GetDays: Integer;
        function GetHours: Integer;
        function GetMinutes: Integer;
        function GetSeconds: Integer;
        function GetMilliseconds: Integer;
        function GetTotalDays: Double; inline;
        function GetTotalHours: Double; inline;
        function GetTotalMinutes: Double; inline;
        function GetTotalSeconds: Double; inline;
        function GetTotalMilliseconds: Double; inline;
        class function GetScaledInterval(Value: Double; Scale: Int64): TTimeSpan; static;
        class constructor Create;
      strict private class var
        FMinValue: TTimeSpan; // FTicks = Low(Int64)
        FMaxValue: TTimeSpan; // FTicks = High(Int64)
        FZero: TTimeSpan;
      public const
        TicksPerMillisecond = 10000;
        TicksPerSecond = MSecsPerSec * Int64(TicksPerMillisecond);
        TicksPerMinute = SecsPerMin * Int64(TicksPerSecond);
        TicksPerHour = MinsPerHour * Int64(TicksPerMinute);
        TicksPerDay = HoursPerDay * TicksPerHour;
      public
        constructor Create(ATicks: Int64);
        constructor Create(Hours, Minutes, Seconds: Integer);
        constructor Create(Days, Hours, Minutes, Seconds: Integer);
        constructor Create(Days, Hours, Minutes, Seconds, Milliseconds: Integer);
    
        function Duration: TTimeSpan;
        function ToString: string;
    
        class function FromDays(Value: Double): TTimeSpan; static; inline;
        class function FromHours(Value: Double): TTimeSpan; static; inline;
        class function FromMinutes(Value: Double): TTimeSpan; static; inline;
        class function FromSeconds(Value: Double): TTimeSpan; static; inline;
        class function FromMilliseconds(Value: Double): TTimeSpan; static; inline;
        class function FromTicks(Value: Int64): TTimeSpan; static;
        class function Subtract(const Left, Right: TDateTime): TTimeSpan; static;
    
        class function Parse(const S: string): TTimeSpan; static;
        class function TryParse(const S: string; out Value: TTimeSpan): Boolean; static;
    
        class operator +(const Left, Right: TTimeSpan): TTimeSpan;
        class operator +(const Left: TTimeSpan; Right: TDateTime): TDateTime;
        class operator +(const Left: TDateTime; const Right: TTimeSpan): TDateTime;
        class operator -(const Value: TTimeSpan): TTimeSpan; // Negate
        class operator -(const Left, Right: TTimeSpan): TTimeSpan;
        class operator -(const Left: TDateTime; const Right: TTimeSpan): TDateTime;
        class operator =(const Left, Right: TTimeSpan): Boolean; inline;
        class operator <>(const Left, Right: TTimeSpan): Boolean; inline;
        class operator >(const Left, Right: TTimeSpan): Boolean; inline;
        class operator >=(const Left, Right: TTimeSpan): Boolean; inline;
        class operator <(const Left, Right: TTimeSpan): Boolean; inline;
        class operator <=(const Left, Right: TTimeSpan): Boolean; inline;
        class operator :=(const Value: TTimeSpan): string;
        class operator Explicit(const Value: TTimeSpan): string;
    
        property Ticks: Int64 read FTicks;
        property Days: Integer read GetDays;
        property Hours: Integer read GetHours;
        property Minutes: Integer read GetMinutes;
        property Seconds: Integer read GetSeconds;
        property Milliseconds: Integer read GetMilliseconds;
        property TotalDays: Double read GetTotalDays;
        property TotalHours: Double read GetTotalHours;
        property TotalMinutes: Double read GetTotalMinutes;
        property TotalSeconds: Double read GetTotalSeconds;
        property TotalMilliseconds: Double read GetTotalMilliseconds;
    
        class property MinValue: TTimeSpan read FMinValue;
        class property MaxValue: TTimeSpan read FMaxValue;
        class property Zero: TTimeSpan read FZero;
      end;
    
    implementation
    
    uses Math;
    
    resourcestring
      SValueCannotBeNan = 'Value cannot be NaN';
      STimespanTooLong = 'Timespan too long';
      SInvalidTimespanDuration = 'The duration cannot be returned because the ' +
        'absolute value exceeds the value of TTimeSpan.MaxValue';
      SCannotNegateTimespan = 'Negating the minimum value of a Timespan is invalid';
      SInvalidTimespanFormat = 'Invalid Timespan format';
      STimespanElementTooLong = 'Timespan element too long';
      SParseNullArgument = 'String is null';
    
    procedure RaiseValueCannotBeNanEArgumentException; noreturn;
    begin
      raise EArgumentException.Create(SValueCannotBeNan)
        at get_caller_addr(get_frame), get_caller_frame(get_frame);
    end;
    
    procedure RaiseTimespanTooLongEIntOverflow; noreturn;
    begin
      raise EIntOverflow.Create(STimespanTooLong)
        at get_caller_addr(get_frame), get_caller_frame(get_frame);
    end;
    
    procedure RaiseTimespanTooLongEArgumentOutOfRangeException; noreturn;
    begin
      raise EArgumentOutOfRangeException.Create(STimespanTooLong)
        at get_caller_addr(get_frame), get_caller_frame(get_frame);
    end;
    
    procedure RaiseInvalidTimespanDurationEIntOverflow; noreturn;
    begin
      raise EIntOverflow.Create(SInvalidTimespanDuration)
        at get_caller_addr(get_frame), get_caller_frame(get_frame);
    end;
    
    procedure RaiseCannotNegateTimespanEIntOverflow; noreturn;
    begin
      raise EIntOverflow.Create(SCannotNegateTimespan)
        at get_caller_addr(get_frame), get_caller_frame(get_frame);
    end;
    
    procedure RaiseInvalidTimeSpanFormatEConvertError; noreturn;
    begin
      raise EConvertError.CreateRes(@SInvalidTimespanFormat)
        at get_caller_addr(get_frame), get_caller_frame(get_frame);
    end;
    
    procedure RaiseTimespanElementTooLongException; noreturn;
    begin
      raise EIntOverflow.Create(STimespanElementTooLong)
        at get_caller_addr(get_frame), get_caller_frame(get_frame);
    end;
    
    procedure RaiseParseNullArgumentEArgumentNilException; noreturn;
    begin
      raise EArgumentNilException.Create(SParseNullArgument)
        at get_caller_addr(get_frame), get_caller_frame(get_frame);
    end;
    
    
    function DateTimeToMSecs(const Value: TDateTime): Int64;
    var
      R: TTimeStamp;
    begin
      R := DateTimeToTimeStamp(Value);
      Result := Int64(R.Date) * MSecsPerDay + R.Time;
    end;
    
    // For big Value ERangeError raised
    function MSecsToDateTime(const Value: Int64): TDateTime;
    var
      R: TTimeStamp;
    begin
      R.Date := Value div MSecsPerDay;
      R.Time := Value mod MSecsPerDay;
      Result := TimeStampToDateTime(R);
    end;
    
    class operator TTimeSpan. + (const Left, Right: TTimeSpan): TTimeSpan;
    var
      Sum: Int64;
      LeftHighBit, RightHighBit, SumHighBit: SizeInt;
    begin
      {$PUSH} {$OVERFLOWCHECKS OFF}
        Sum := Left.Ticks + Right.Ticks;
      {$POP}
      LeftHighBit := Left.Ticks shr 63;
      RightHighBit := Right.Ticks shr 63;
      SumHighBit := Sum shr 63;
      if (LeftHighBit = RightHighBit) and (LeftHighBit <> SumHighBit) then
        RaiseTimespanTooLongEIntOverflow;
      Result := TTimeSpan.Create(Sum);
    end;
    
    class operator TTimeSpan. + (const Left: TDateTime; const Right: TTimeSpan): TDateTime;
    begin
      Result := MSecsToDateTime(DateTimeToMSecs(Left) + (Right.Ticks div TicksPerMillisecond));
    end;
    
    class operator TTimeSpan. + (const Left: TTimeSpan; Right: TDateTime): TDateTime;
    begin
      Result := Right + Left;
    end;
    
    class function TTimeSpan.Subtract(const Left, Right: TDateTime): TTimeSpan;
    begin
      Result := TTimeSpan.Create(
        (DateTimeToMSecs(Left) - DateTimeToMSecs(Right)) * TicksPerMillisecond);
    end;
    
    class operator TTimeSpan. - (const Left, Right: TTimeSpan): TTimeSpan;
    begin
      Result := Left + (-Right);
    end;
    
    class operator TTimeSpan. - (const Left: TDateTime; const Right: TTimeSpan): TDateTime;
    begin
      Result := Left + (-Right);
    end;
    
    class operator TTimeSpan. - (const Value: TTimeSpan): TTimeSpan;
    begin
      if Value.Ticks = Low(Int64) then // Compatible with .NET
        RaiseCannotNegateTimespanEIntOverflow;
      Result := TTimeSpan.Create(-Value.Ticks);
    end;
    
    class operator TTimeSpan. := (const Value: TTimeSpan): string;
    begin
      Result := Value.ToString;
    end;
    
    class operator TTimeSpan.<(const Left, Right: TTimeSpan): Boolean;
    begin
      Result := (Left.FTicks < Right.FTicks);
    end;
    
    class operator TTimeSpan.<=(const Left, Right: TTimeSpan): Boolean;
    begin
      Result := (Left.FTicks <= Right.FTicks);
    end;
    
    class operator TTimeSpan.<>(const Left, Right: TTimeSpan): Boolean;
    begin
      Result := (Left.FTicks <> Right.FTicks);
    end;
    
    class operator TTimeSpan. = (const Left, Right: TTimeSpan): Boolean;
    begin
      Result := (Left.FTicks = Right.FTicks);
    end;
    
    class operator TTimeSpan.>(const Left, Right: TTimeSpan): Boolean;
    begin
      Result := (Left.FTicks > Right.FTicks);
    end;
    
    class operator TTimeSpan.>=(const Left, Right: TTimeSpan): Boolean;
    begin
      Result := (Left.FTicks >= Right.FTicks);
    end;
    
    class operator TTimeSpan.Explicit(const Value: TTimeSpan): string;
    begin
      Result := Value.ToString;
    end;
    
    class constructor TTimeSpan.Create;
    begin
      FMinValue.FTicks := Low(FMinValue.FTicks);
      FMaxValue.FTicks := High(FMaxValue.FTicks);
      //FZero.FTicks := 0; // Default is zero
    end;
    
    constructor TTimeSpan.Create(Days, Hours, Minutes, Seconds, Milliseconds: Integer);
    const
      CMaxMSecs = High(Int64) div TicksPerMillisecond;
      CMinMSecs = Low(Int64) div TicksPerMillisecond;
    begin
      FTicks := MSecsPerSec * (
        SecsPerMin * (
          MinsPerHour * (
              HoursPerDay * Int64(Days) + Hours)
          + Minutes)
        + Seconds) + Milliseconds;
      if not InRange(FTicks, CMinMSecs, CMaxMSecs) then
        RaiseTimespanTooLongEArgumentOutOfRangeException;
      FTicks := FTicks * TicksPerMillisecond;
    end;
    
    constructor TTimeSpan.Create(Days, Hours, Minutes, Seconds: Integer);
    begin
      Create(Days, Hours, Minutes, Seconds, 0);
    end;
    
    constructor TTimeSpan.Create(Hours, Minutes, Seconds: Integer);
    begin
      Create(0, Hours, Minutes, Seconds, 0);
    end;
    
    constructor TTimeSpan.Create(ATicks: Int64);
    begin
      FTicks := ATicks;
    end;
    
    function TTimeSpan.Duration: TTimeSpan;
    begin
      if FTicks = Low(Int64) then // Compatible with .NET
        RaiseInvalidTimespanDurationEIntOverflow;
      Result := TTimeSpan.Create(Abs(FTicks));
    end;
    
    class function TTimeSpan.FromDays(Value: Double): TTimeSpan;
    begin
      Result := GetScaledInterval(Value, TicksPerDay);
    end;
    
    class function TTimeSpan.FromHours(Value: Double): TTimeSpan;
    begin
      Result := GetScaledInterval(Value, TicksPerHour);
    end;
    
    class function TTimeSpan.FromMilliseconds(Value: Double): TTimeSpan;
    begin
      Result := GetScaledInterval(Value, TicksPerMillisecond);
    end;
    
    class function TTimeSpan.FromMinutes(Value: Double): TTimeSpan;
    begin
      Result := GetScaledInterval(Value, TicksPerMinute);
    end;
    
    class function TTimeSpan.FromSeconds(Value: Double): TTimeSpan;
    begin
      Result := GetScaledInterval(Value, TicksPerSecond);
    end;
    
    class function TTimeSpan.FromTicks(Value: Int64): TTimeSpan;
    begin
      Result := TTimeSpan.Create(Value);
    end;
    
    function TTimeSpan.GetDays: Integer;
    begin
      Result := Integer(FTicks div TicksPerDay);
    end;
    
    function TTimeSpan.GetHours: Integer;
    begin
      Result := Integer(FTicks div TicksPerHour) mod HoursPerDay;
    end;
    
    function TTimeSpan.GetMilliseconds: Integer;
    begin
      Result := Integer(FTicks div TicksPerMillisecond) mod MSecsPerSec;
    end;
    
    function TTimeSpan.GetMinutes: Integer;
    begin
      Result := Integer(FTicks div TicksPerMinute) mod MinsPerHour;
    end;
    
    class function TTimeSpan.GetScaledInterval(Value: Double; Scale: Int64): TTimeSpan;
    var
      NewVal: Double;
    begin
      if IsNan(Value) then
        RaiseValueCannotBeNanEArgumentException;
      NewVal := Value * Scale;
      if Value >= 0.0 then
        NewVal := NewVal + 0.5
      else
        NewVal := NewVal - 0.5;
      if not InRange(NewVal, Low(Int64), High(Int64)) then
        RaiseTimespanTooLongEIntOverflow;
      Result := TTimeSpan.Create(Trunc(NewVal));
    end;
    
    function TTimeSpan.GetSeconds: Integer;
    begin
      Result := Integer(FTicks div TicksPerSecond) mod SecsPerMin;
    end;
    
    function TTimeSpan.GetTotalDays: Double;
    begin
      Result := FTicks / TicksPerDay;
    end;
    
    function TTimeSpan.GetTotalHours: Double;
    begin
      Result := FTicks / TicksPerHour;
    end;
    
    function TTimeSpan.GetTotalMilliseconds: Double;
    begin
      Result := FTicks / TicksPerMillisecond;
    end;
    
    function TTimeSpan.GetTotalMinutes: Double;
    begin
      Result := FTicks / TicksPerMinute;
    end;
    
    function TTimeSpan.GetTotalSeconds: Double;
    begin
      Result := FTicks / TicksPerSecond;
    end;
    
    type
      TParseResult = (prOK, prNull, prFormat, prOverflow, prElementTooLong);
    
    {$PUSH} {$OVERFLOWCHECKS OFF}
    function ParseStr(const S: string; out Value: Int64): TParseResult;
    // Format: [ws][-]{ d | [d.]hh:mm[:ss[.fff]] }[ws]
    // [optional], {|} one of
    // ws - whitespace
    // d - days 0..10675199 (=High(Int64) div TicksPerDay)
    // hh - hours 0..23
    // mm - minutes 0..59
    // ss - seconds 0..59
    // ff - fractional seconds, up to 7 digits
    var
      IntPart: Integer;
    
      function AddDays: Boolean;
      begin
        Result := IntPart <= (High(Int64) div TTimeSpan.TicksPerDay);
        if not Result then
          Exit;
        Inc(Value, TTimeSpan.TicksPerDay * IntPart);
        IntPart := 0;
      end;
    
      function AddHours: Boolean;
      begin
        Result := (IntPart < HoursPerDay);
        if not Result then
          Exit;
        Inc(Value, TTimeSpan.TicksPerHour * IntPart);
        IntPart := 0;
      end;
    
      function AddMinutes: Boolean;
      begin
        Result := (IntPart < MinsPerHour);
        if not Result then
          Exit;
        Inc(Value, Int64(TTimeSpan.TicksPerMinute) * IntPart);
        IntPart := 0;
      end;
    
      function AddSeconds: Boolean;
      begin
        Result := (IntPart < SecsPerMin);
        if not Result then
          Exit;
        Inc(Value, Int64(TTimeSpan.TicksPerSecond) * IntPart);
        IntPart := TTimeSpan.TicksPerSecond;
      end;
    
    const
      CValidChars = [' ', '.', ':', '-', '0'..'9'];
    type
      TParsedSection = (psHead, psDaysOrHours, psHours, psMinutes, psSeconds, psMSecs);
      TValidChars = set of Low(CValidChars)..High(CValidChars);
    var
      C: Char;
      PosS, LengthS: SizeInt;
      Digit: Integer;
      ExpectedChars: TValidChars;
      ParsedSection: TParsedSection;
      Negative: Boolean;
    begin
      Value := 0;
      LengthS := Length(S);
      if LengthS = 0 then
        Exit(prNull);
      ParsedSection := psHead;
      ExpectedChars := [' ', '-', '0'..'9'];
      Negative := False;
      IntPart := 0;
      PosS := Low(S);
      repeat
        C := S[PosS];
        if not (C in ExpectedChars) then
          Exit(prFormat);
        Exclude(ExpectedChars, '-');
        case C of
           ' ':
             case ParsedSection of
               psHead:
                 Include(ExpectedChars, '-');
               psDaysOrHours, psMinutes, psSeconds, psMSecs:
                 ExpectedChars := [' ']; // The rest are only whitespace
             else
               Exit(prFormat);
             end;
           '-':
             begin
               if ParsedSection <> psHead then
                 Exit(prFormat);
               Negative := True;
             end;
           '.':
             begin
               Exclude(ExpectedChars, '.');
               case ParsedSection of
                 psDaysOrHours:   // '.' mean days, not hours
                   if not AddDays then
                     Exit(prElementTooLong);
                 psSeconds:
                   if not AddSeconds then
                     Exit(prElementTooLong);
               else
                 Exit(prFormat);
               end;
               Inc(ParsedSection);
             end;
           '0'..'9':
             begin
               Include(ExpectedChars, '.');
               Include(ExpectedChars, ':');
               Digit := Ord(C) - Ord('0');
               if ParsedSection <> psMSecs then
               begin
                 IntPart := IntPart * 10 + Digit;
                 if IntPart > 9999999 then // All sections less than 1E8
                   Exit(prElementTooLong);
               end
               else
               begin
                 IntPart := IntPart div 10;   // Start IntPart = TicksPerSecond
                 Inc(Value, Digit * Int64(IntPart));
                 if IntPart = 0 then
                   Exit(prElementTooLong);
               end;
               if ParsedSection = psHead then
                 ParsedSection := psDaysOrHours;
             end;
           ':':
             begin
               Exclude(ExpectedChars, ':');
               case ParsedSection of
                 psDaysOrHours, psHours:  // ':' mean hours, not days
                   if not AddHours then
                     Exit(prElementTooLong);
                 psMinutes:
                   if not AddMinutes then
                     Exit(prElementTooLong);
               else
                 Exit(prFormat);
               end;
               Inc(ParsedSection);
               if ParsedSection = psHours then
                 Inc(ParsedSection);
             end;
        else
          Exit(prFormat);
        end;
        Inc(PosS);
      until PosS > LengthS;
      if (C in ['.', ':']) and not (C in ExpectedChars) then
        Exit(prFormat); // Unexpected end with delimiter
      case ParsedSection of
        psHead:
          Exit(prNull);
        psDaysOrHours:
          if not AddDays then
            Exit(prElementTooLong);
        psMinutes:
          if not AddMinutes then
            Exit(prElementTooLong);
        psSeconds:
          if not AddSeconds then
            Exit(prElementTooLong);
        psMSecs:
          { Already done };
      else
        Exit(prFormat);
      end;
      if Negative then
      begin
        Value := -Value;
        if Value > 0 then
          Exit(prOverflow);
      end
      else
        if Value < 0 then
          Exit(prOverflow);
      Result := prOK;
    end;
    {$POP OVERFLOWCHECKS}
    
    class function TTimeSpan.Parse(const S: string): TTimeSpan;
    var
      LTicks: Int64;
    begin
      case ParseStr(S, LTicks) of
        prOK:
          {OK};
        prNull:
          RaiseParseNullArgumentEArgumentNilException;
        prFormat:
          RaiseInvalidTimeSpanFormatEConvertError;
        prOverflow:
          RaiseTimespanTooLongEIntOverflow;
        prElementTooLong:
          RaiseTimespanElementTooLongException;
      end;
      Result := TTimeSpan.Create(LTicks);
    end;
    
    function TTimeSpan.ToString: string;
    var
      Fmt: string;
      LDays, SubSecondTicks: Integer;
      LTicks: Int64;
    begin
      Fmt := '%1:.2d:%2:.2d:%3:.2d'; // do not localize
      LDays := Abs(FTicks) div TicksPerDay;
      LTicks := Abs(FTicks) mod TicksPerDay;
      if LDays <> 0 then
        Fmt := '%0:d.' + Fmt; // do not localize
      SubSecondTicks := LTicks mod TicksPerSecond;
      if SubSecondTicks <> 0 then
        Fmt := Fmt + '.%4:.7d'; // do not localize
      if FTicks < 0 then
        Fmt := '-' + Fmt;
      Result := Format(Fmt,
        [LDays,
        (LTicks div TicksPerHour) mod HoursPerDay,
        (LTicks div TicksPerMinute) mod MinsPerHour,
        (LTicks div TicksPerSecond) mod SecsPerMin,
        SubSecondTicks]);
    end;
    
    class function TTimeSpan.TryParse(const S: string; out Value: TTimeSpan): Boolean;
    var
      LTicks: Int64;
    begin
      Result := (ParseStr(S, LTicks) = prOk);
      if Result then
        Value := TTimeSpan.Create(LTicks);
    end;
    
    end.
    
    
    TimeSpan-2.pp (19,715 bytes)

Activities

Thaddy de Koning

2019-07-15 09:14

reporter   ~0117263

Last edited: 2019-07-15 09:18

View 3 revisions

The Delphi implementation is flawed.
  TTimeSpan = record
  private
    FTicks: Int64;

Whereas the rest is strict...as it should be for the above too.

From the declaration alone, you can already see it is half a job. I wonder how this could make production.
That doesn't mean we should not implement it (not too difficult), but the Delphi code is everything except clean.

Serge Anvarov

2019-07-23 11:03

reporter   ~0117351

Last edited: 2019-07-23 11:04

View 2 revisions

Here is implementation. For some strange reason, FPC 3.0.4 x64 can not compile the unit (under Windows). FPC 3.0.4, x32 and FPC 3.3.1, x64 doing this.
Admins, please, remove first attach.



TimeSpan-2.pp (19,715 bytes)
unit TimeSpan;

{$MODE OBJFPC}
{$MODESWITCH ADVANCEDRECORDS}
{$LONGSTRINGS ON}

interface

{ Difference from Delphi 10.3 (RIO):
1. [+] or [-] operator raise EIntOverflow, not EArgumentOutOfRangeException
  Reason: compatible with .NET
2. Methods FromDays, FromHours, FromMilliseconds, FromMinutes, FromSeconds
  raise EIntOverflow, not EArgumentOutOfRangeException
  Reason: compatible with .NET
3. Method Parse raise EConvertError, not Exception, when invalid format
  Reason: compatible with .NET
4. Method Parse raise EArgumentNilException, not Exception for null string
  Reason: compatible with .NET
5. Method Parse more strict. For example it's reject string '1:0:0.', because
  last dot is invalid. Delphi ignore it.
  Reason: compatible with .NET
6. Method ToString always prints '-' for negative timespan. Example:
  TTimeSpan.Parse('-1:0:0').ToString show '-01:00:00', but '01:00:00' in Delphi
  Reason: Delphi implementation error
}

uses SysUtils;

type
  TTimeSpan = record
  strict private
    FTicks: Int64;
    function GetDays: Integer;
    function GetHours: Integer;
    function GetMinutes: Integer;
    function GetSeconds: Integer;
    function GetMilliseconds: Integer;
    function GetTotalDays: Double; inline;
    function GetTotalHours: Double; inline;
    function GetTotalMinutes: Double; inline;
    function GetTotalSeconds: Double; inline;
    function GetTotalMilliseconds: Double; inline;
    class function GetScaledInterval(Value: Double; Scale: Int64): TTimeSpan; static;
    class constructor Create;
  strict private class var
    FMinValue: TTimeSpan; // FTicks = Low(Int64)
    FMaxValue: TTimeSpan; // FTicks = High(Int64)
    FZero: TTimeSpan;
  public const
    TicksPerMillisecond = 10000;
    TicksPerSecond = MSecsPerSec * Int64(TicksPerMillisecond);
    TicksPerMinute = SecsPerMin * Int64(TicksPerSecond);
    TicksPerHour = MinsPerHour * Int64(TicksPerMinute);
    TicksPerDay = HoursPerDay * TicksPerHour;
  public
    constructor Create(ATicks: Int64);
    constructor Create(Hours, Minutes, Seconds: Integer);
    constructor Create(Days, Hours, Minutes, Seconds: Integer);
    constructor Create(Days, Hours, Minutes, Seconds, Milliseconds: Integer);

    function Duration: TTimeSpan;
    function ToString: string;

    class function FromDays(Value: Double): TTimeSpan; static; inline;
    class function FromHours(Value: Double): TTimeSpan; static; inline;
    class function FromMinutes(Value: Double): TTimeSpan; static; inline;
    class function FromSeconds(Value: Double): TTimeSpan; static; inline;
    class function FromMilliseconds(Value: Double): TTimeSpan; static; inline;
    class function FromTicks(Value: Int64): TTimeSpan; static;
    class function Subtract(const Left, Right: TDateTime): TTimeSpan; static;

    class function Parse(const S: string): TTimeSpan; static;
    class function TryParse(const S: string; out Value: TTimeSpan): Boolean; static;

    class operator +(const Left, Right: TTimeSpan): TTimeSpan;
    class operator +(const Left: TTimeSpan; Right: TDateTime): TDateTime;
    class operator +(const Left: TDateTime; const Right: TTimeSpan): TDateTime;
    class operator -(const Value: TTimeSpan): TTimeSpan; // Negate
    class operator -(const Left, Right: TTimeSpan): TTimeSpan;
    class operator -(const Left: TDateTime; const Right: TTimeSpan): TDateTime;
    class operator =(const Left, Right: TTimeSpan): Boolean; inline;
    class operator <>(const Left, Right: TTimeSpan): Boolean; inline;
    class operator >(const Left, Right: TTimeSpan): Boolean; inline;
    class operator >=(const Left, Right: TTimeSpan): Boolean; inline;
    class operator <(const Left, Right: TTimeSpan): Boolean; inline;
    class operator <=(const Left, Right: TTimeSpan): Boolean; inline;
    class operator :=(const Value: TTimeSpan): string;
    class operator Explicit(const Value: TTimeSpan): string;

    property Ticks: Int64 read FTicks;
    property Days: Integer read GetDays;
    property Hours: Integer read GetHours;
    property Minutes: Integer read GetMinutes;
    property Seconds: Integer read GetSeconds;
    property Milliseconds: Integer read GetMilliseconds;
    property TotalDays: Double read GetTotalDays;
    property TotalHours: Double read GetTotalHours;
    property TotalMinutes: Double read GetTotalMinutes;
    property TotalSeconds: Double read GetTotalSeconds;
    property TotalMilliseconds: Double read GetTotalMilliseconds;

    class property MinValue: TTimeSpan read FMinValue;
    class property MaxValue: TTimeSpan read FMaxValue;
    class property Zero: TTimeSpan read FZero;
  end;

implementation

uses Math;

resourcestring
  SValueCannotBeNan = 'Value cannot be NaN';
  STimespanTooLong = 'Timespan too long';
  SInvalidTimespanDuration = 'The duration cannot be returned because the ' +
    'absolute value exceeds the value of TTimeSpan.MaxValue';
  SCannotNegateTimespan = 'Negating the minimum value of a Timespan is invalid';
  SInvalidTimespanFormat = 'Invalid Timespan format';
  STimespanElementTooLong = 'Timespan element too long';
  SParseNullArgument = 'String is null';

procedure RaiseValueCannotBeNanEArgumentException; noreturn;
begin
  raise EArgumentException.Create(SValueCannotBeNan)
    at get_caller_addr(get_frame), get_caller_frame(get_frame);
end;

procedure RaiseTimespanTooLongEIntOverflow; noreturn;
begin
  raise EIntOverflow.Create(STimespanTooLong)
    at get_caller_addr(get_frame), get_caller_frame(get_frame);
end;

procedure RaiseTimespanTooLongEArgumentOutOfRangeException; noreturn;
begin
  raise EArgumentOutOfRangeException.Create(STimespanTooLong)
    at get_caller_addr(get_frame), get_caller_frame(get_frame);
end;

procedure RaiseInvalidTimespanDurationEIntOverflow; noreturn;
begin
  raise EIntOverflow.Create(SInvalidTimespanDuration)
    at get_caller_addr(get_frame), get_caller_frame(get_frame);
end;

procedure RaiseCannotNegateTimespanEIntOverflow; noreturn;
begin
  raise EIntOverflow.Create(SCannotNegateTimespan)
    at get_caller_addr(get_frame), get_caller_frame(get_frame);
end;

procedure RaiseInvalidTimeSpanFormatEConvertError; noreturn;
begin
  raise EConvertError.CreateRes(@SInvalidTimespanFormat)
    at get_caller_addr(get_frame), get_caller_frame(get_frame);
end;

procedure RaiseTimespanElementTooLongException; noreturn;
begin
  raise EIntOverflow.Create(STimespanElementTooLong)
    at get_caller_addr(get_frame), get_caller_frame(get_frame);
end;

procedure RaiseParseNullArgumentEArgumentNilException; noreturn;
begin
  raise EArgumentNilException.Create(SParseNullArgument)
    at get_caller_addr(get_frame), get_caller_frame(get_frame);
end;


function DateTimeToMSecs(const Value: TDateTime): Int64;
var
  R: TTimeStamp;
begin
  R := DateTimeToTimeStamp(Value);
  Result := Int64(R.Date) * MSecsPerDay + R.Time;
end;

// For big Value ERangeError raised
function MSecsToDateTime(const Value: Int64): TDateTime;
var
  R: TTimeStamp;
begin
  R.Date := Value div MSecsPerDay;
  R.Time := Value mod MSecsPerDay;
  Result := TimeStampToDateTime(R);
end;

class operator TTimeSpan. + (const Left, Right: TTimeSpan): TTimeSpan;
var
  Sum: Int64;
  LeftHighBit, RightHighBit, SumHighBit: SizeInt;
begin
  {$PUSH} {$OVERFLOWCHECKS OFF}
    Sum := Left.Ticks + Right.Ticks;
  {$POP}
  LeftHighBit := Left.Ticks shr 63;
  RightHighBit := Right.Ticks shr 63;
  SumHighBit := Sum shr 63;
  if (LeftHighBit = RightHighBit) and (LeftHighBit <> SumHighBit) then
    RaiseTimespanTooLongEIntOverflow;
  Result := TTimeSpan.Create(Sum);
end;

class operator TTimeSpan. + (const Left: TDateTime; const Right: TTimeSpan): TDateTime;
begin
  Result := MSecsToDateTime(DateTimeToMSecs(Left) + (Right.Ticks div TicksPerMillisecond));
end;

class operator TTimeSpan. + (const Left: TTimeSpan; Right: TDateTime): TDateTime;
begin
  Result := Right + Left;
end;

class function TTimeSpan.Subtract(const Left, Right: TDateTime): TTimeSpan;
begin
  Result := TTimeSpan.Create(
    (DateTimeToMSecs(Left) - DateTimeToMSecs(Right)) * TicksPerMillisecond);
end;

class operator TTimeSpan. - (const Left, Right: TTimeSpan): TTimeSpan;
begin
  Result := Left + (-Right);
end;

class operator TTimeSpan. - (const Left: TDateTime; const Right: TTimeSpan): TDateTime;
begin
  Result := Left + (-Right);
end;

class operator TTimeSpan. - (const Value: TTimeSpan): TTimeSpan;
begin
  if Value.Ticks = Low(Int64) then // Compatible with .NET
    RaiseCannotNegateTimespanEIntOverflow;
  Result := TTimeSpan.Create(-Value.Ticks);
end;

class operator TTimeSpan. := (const Value: TTimeSpan): string;
begin
  Result := Value.ToString;
end;

class operator TTimeSpan.<(const Left, Right: TTimeSpan): Boolean;
begin
  Result := (Left.FTicks < Right.FTicks);
end;

class operator TTimeSpan.<=(const Left, Right: TTimeSpan): Boolean;
begin
  Result := (Left.FTicks <= Right.FTicks);
end;

class operator TTimeSpan.<>(const Left, Right: TTimeSpan): Boolean;
begin
  Result := (Left.FTicks <> Right.FTicks);
end;

class operator TTimeSpan. = (const Left, Right: TTimeSpan): Boolean;
begin
  Result := (Left.FTicks = Right.FTicks);
end;

class operator TTimeSpan.>(const Left, Right: TTimeSpan): Boolean;
begin
  Result := (Left.FTicks > Right.FTicks);
end;

class operator TTimeSpan.>=(const Left, Right: TTimeSpan): Boolean;
begin
  Result := (Left.FTicks >= Right.FTicks);
end;

class operator TTimeSpan.Explicit(const Value: TTimeSpan): string;
begin
  Result := Value.ToString;
end;

class constructor TTimeSpan.Create;
begin
  FMinValue.FTicks := Low(FMinValue.FTicks);
  FMaxValue.FTicks := High(FMaxValue.FTicks);
  //FZero.FTicks := 0; // Default is zero
end;

constructor TTimeSpan.Create(Days, Hours, Minutes, Seconds, Milliseconds: Integer);
const
  CMaxMSecs = High(Int64) div TicksPerMillisecond;
  CMinMSecs = Low(Int64) div TicksPerMillisecond;
begin
  FTicks := MSecsPerSec * (
    SecsPerMin * (
      MinsPerHour * (
          HoursPerDay * Int64(Days) + Hours)
      + Minutes)
    + Seconds) + Milliseconds;
  if not InRange(FTicks, CMinMSecs, CMaxMSecs) then
    RaiseTimespanTooLongEArgumentOutOfRangeException;
  FTicks := FTicks * TicksPerMillisecond;
end;

constructor TTimeSpan.Create(Days, Hours, Minutes, Seconds: Integer);
begin
  Create(Days, Hours, Minutes, Seconds, 0);
end;

constructor TTimeSpan.Create(Hours, Minutes, Seconds: Integer);
begin
  Create(0, Hours, Minutes, Seconds, 0);
end;

constructor TTimeSpan.Create(ATicks: Int64);
begin
  FTicks := ATicks;
end;

function TTimeSpan.Duration: TTimeSpan;
begin
  if FTicks = Low(Int64) then // Compatible with .NET
    RaiseInvalidTimespanDurationEIntOverflow;
  Result := TTimeSpan.Create(Abs(FTicks));
end;

class function TTimeSpan.FromDays(Value: Double): TTimeSpan;
begin
  Result := GetScaledInterval(Value, TicksPerDay);
end;

class function TTimeSpan.FromHours(Value: Double): TTimeSpan;
begin
  Result := GetScaledInterval(Value, TicksPerHour);
end;

class function TTimeSpan.FromMilliseconds(Value: Double): TTimeSpan;
begin
  Result := GetScaledInterval(Value, TicksPerMillisecond);
end;

class function TTimeSpan.FromMinutes(Value: Double): TTimeSpan;
begin
  Result := GetScaledInterval(Value, TicksPerMinute);
end;

class function TTimeSpan.FromSeconds(Value: Double): TTimeSpan;
begin
  Result := GetScaledInterval(Value, TicksPerSecond);
end;

class function TTimeSpan.FromTicks(Value: Int64): TTimeSpan;
begin
  Result := TTimeSpan.Create(Value);
end;

function TTimeSpan.GetDays: Integer;
begin
  Result := Integer(FTicks div TicksPerDay);
end;

function TTimeSpan.GetHours: Integer;
begin
  Result := Integer(FTicks div TicksPerHour) mod HoursPerDay;
end;

function TTimeSpan.GetMilliseconds: Integer;
begin
  Result := Integer(FTicks div TicksPerMillisecond) mod MSecsPerSec;
end;

function TTimeSpan.GetMinutes: Integer;
begin
  Result := Integer(FTicks div TicksPerMinute) mod MinsPerHour;
end;

class function TTimeSpan.GetScaledInterval(Value: Double; Scale: Int64): TTimeSpan;
var
  NewVal: Double;
begin
  if IsNan(Value) then
    RaiseValueCannotBeNanEArgumentException;
  NewVal := Value * Scale;
  if Value >= 0.0 then
    NewVal := NewVal + 0.5
  else
    NewVal := NewVal - 0.5;
  if not InRange(NewVal, Low(Int64), High(Int64)) then
    RaiseTimespanTooLongEIntOverflow;
  Result := TTimeSpan.Create(Trunc(NewVal));
end;

function TTimeSpan.GetSeconds: Integer;
begin
  Result := Integer(FTicks div TicksPerSecond) mod SecsPerMin;
end;

function TTimeSpan.GetTotalDays: Double;
begin
  Result := FTicks / TicksPerDay;
end;

function TTimeSpan.GetTotalHours: Double;
begin
  Result := FTicks / TicksPerHour;
end;

function TTimeSpan.GetTotalMilliseconds: Double;
begin
  Result := FTicks / TicksPerMillisecond;
end;

function TTimeSpan.GetTotalMinutes: Double;
begin
  Result := FTicks / TicksPerMinute;
end;

function TTimeSpan.GetTotalSeconds: Double;
begin
  Result := FTicks / TicksPerSecond;
end;

type
  TParseResult = (prOK, prNull, prFormat, prOverflow, prElementTooLong);

{$PUSH} {$OVERFLOWCHECKS OFF}
function ParseStr(const S: string; out Value: Int64): TParseResult;
// Format: [ws][-]{ d | [d.]hh:mm[:ss[.fff]] }[ws]
// [optional], {|} one of
// ws - whitespace
// d - days 0..10675199 (=High(Int64) div TicksPerDay)
// hh - hours 0..23
// mm - minutes 0..59
// ss - seconds 0..59
// ff - fractional seconds, up to 7 digits
var
  IntPart: Integer;

  function AddDays: Boolean;
  begin
    Result := IntPart <= (High(Int64) div TTimeSpan.TicksPerDay);
    if not Result then
      Exit;
    Inc(Value, TTimeSpan.TicksPerDay * IntPart);
    IntPart := 0;
  end;

  function AddHours: Boolean;
  begin
    Result := (IntPart < HoursPerDay);
    if not Result then
      Exit;
    Inc(Value, TTimeSpan.TicksPerHour * IntPart);
    IntPart := 0;
  end;

  function AddMinutes: Boolean;
  begin
    Result := (IntPart < MinsPerHour);
    if not Result then
      Exit;
    Inc(Value, Int64(TTimeSpan.TicksPerMinute) * IntPart);
    IntPart := 0;
  end;

  function AddSeconds: Boolean;
  begin
    Result := (IntPart < SecsPerMin);
    if not Result then
      Exit;
    Inc(Value, Int64(TTimeSpan.TicksPerSecond) * IntPart);
    IntPart := TTimeSpan.TicksPerSecond;
  end;

const
  CValidChars = [' ', '.', ':', '-', '0'..'9'];
type
  TParsedSection = (psHead, psDaysOrHours, psHours, psMinutes, psSeconds, psMSecs);
  TValidChars = set of Low(CValidChars)..High(CValidChars);
var
  C: Char;
  PosS, LengthS: SizeInt;
  Digit: Integer;
  ExpectedChars: TValidChars;
  ParsedSection: TParsedSection;
  Negative: Boolean;
begin
  Value := 0;
  LengthS := Length(S);
  if LengthS = 0 then
    Exit(prNull);
  ParsedSection := psHead;
  ExpectedChars := [' ', '-', '0'..'9'];
  Negative := False;
  IntPart := 0;
  PosS := Low(S);
  repeat
    C := S[PosS];
    if not (C in ExpectedChars) then
      Exit(prFormat);
    Exclude(ExpectedChars, '-');
    case C of
       ' ':
         case ParsedSection of
           psHead:
             Include(ExpectedChars, '-');
           psDaysOrHours, psMinutes, psSeconds, psMSecs:
             ExpectedChars := [' ']; // The rest are only whitespace
         else
           Exit(prFormat);
         end;
       '-':
         begin
           if ParsedSection <> psHead then
             Exit(prFormat);
           Negative := True;
         end;
       '.':
         begin
           Exclude(ExpectedChars, '.');
           case ParsedSection of
             psDaysOrHours:   // '.' mean days, not hours
               if not AddDays then
                 Exit(prElementTooLong);
             psSeconds:
               if not AddSeconds then
                 Exit(prElementTooLong);
           else
             Exit(prFormat);
           end;
           Inc(ParsedSection);
         end;
       '0'..'9':
         begin
           Include(ExpectedChars, '.');
           Include(ExpectedChars, ':');
           Digit := Ord(C) - Ord('0');
           if ParsedSection <> psMSecs then
           begin
             IntPart := IntPart * 10 + Digit;
             if IntPart > 9999999 then // All sections less than 1E8
               Exit(prElementTooLong);
           end
           else
           begin
             IntPart := IntPart div 10;   // Start IntPart = TicksPerSecond
             Inc(Value, Digit * Int64(IntPart));
             if IntPart = 0 then
               Exit(prElementTooLong);
           end;
           if ParsedSection = psHead then
             ParsedSection := psDaysOrHours;
         end;
       ':':
         begin
           Exclude(ExpectedChars, ':');
           case ParsedSection of
             psDaysOrHours, psHours:  // ':' mean hours, not days
               if not AddHours then
                 Exit(prElementTooLong);
             psMinutes:
               if not AddMinutes then
                 Exit(prElementTooLong);
           else
             Exit(prFormat);
           end;
           Inc(ParsedSection);
           if ParsedSection = psHours then
             Inc(ParsedSection);
         end;
    else
      Exit(prFormat);
    end;
    Inc(PosS);
  until PosS > LengthS;
  if (C in ['.', ':']) and not (C in ExpectedChars) then
    Exit(prFormat); // Unexpected end with delimiter
  case ParsedSection of
    psHead:
      Exit(prNull);
    psDaysOrHours:
      if not AddDays then
        Exit(prElementTooLong);
    psMinutes:
      if not AddMinutes then
        Exit(prElementTooLong);
    psSeconds:
      if not AddSeconds then
        Exit(prElementTooLong);
    psMSecs:
      { Already done };
  else
    Exit(prFormat);
  end;
  if Negative then
  begin
    Value := -Value;
    if Value > 0 then
      Exit(prOverflow);
  end
  else
    if Value < 0 then
      Exit(prOverflow);
  Result := prOK;
end;
{$POP OVERFLOWCHECKS}

class function TTimeSpan.Parse(const S: string): TTimeSpan;
var
  LTicks: Int64;
begin
  case ParseStr(S, LTicks) of
    prOK:
      {OK};
    prNull:
      RaiseParseNullArgumentEArgumentNilException;
    prFormat:
      RaiseInvalidTimeSpanFormatEConvertError;
    prOverflow:
      RaiseTimespanTooLongEIntOverflow;
    prElementTooLong:
      RaiseTimespanElementTooLongException;
  end;
  Result := TTimeSpan.Create(LTicks);
end;

function TTimeSpan.ToString: string;
var
  Fmt: string;
  LDays, SubSecondTicks: Integer;
  LTicks: Int64;
begin
  Fmt := '%1:.2d:%2:.2d:%3:.2d'; // do not localize
  LDays := Abs(FTicks) div TicksPerDay;
  LTicks := Abs(FTicks) mod TicksPerDay;
  if LDays <> 0 then
    Fmt := '%0:d.' + Fmt; // do not localize
  SubSecondTicks := LTicks mod TicksPerSecond;
  if SubSecondTicks <> 0 then
    Fmt := Fmt + '.%4:.7d'; // do not localize
  if FTicks < 0 then
    Fmt := '-' + Fmt;
  Result := Format(Fmt,
    [LDays,
    (LTicks div TicksPerHour) mod HoursPerDay,
    (LTicks div TicksPerMinute) mod MinsPerHour,
    (LTicks div TicksPerSecond) mod SecsPerMin,
    SubSecondTicks]);
end;

class function TTimeSpan.TryParse(const S: string; out Value: TTimeSpan): Boolean;
var
  LTicks: Int64;
begin
  Result := (ParseStr(S, LTicks) = prOk);
  if Result then
    Value := TTimeSpan.Create(LTicks);
end;

end.

TimeSpan-2.pp (19,715 bytes)

Thaddy de Koning

2019-07-23 14:30

reporter   ~0117352

Last edited: 2019-07-23 14:35

View 2 revisions

Good job and my tests worked! works on armhf-linux too (3.2.0 and 3.3.1-r42460)

There may be some point - for the time being - to solve the compatibility issue 6 with using abs() in Delphi modes.

rd0x

2019-07-23 14:55

reporter   ~0117353

@Serge
wow - nice work!

@Thaddy
maybe add your tests so that they could be added to testsuite :)

Issue History

Date Modified Username Field Change
2019-07-13 11:18 rd0x New Issue
2019-07-15 09:14 Thaddy de Koning Note Added: 0117263
2019-07-15 09:17 Thaddy de Koning Note Edited: 0117263 View Revisions
2019-07-15 09:18 Thaddy de Koning Note Edited: 0117263 View Revisions
2019-07-23 11:01 Serge Anvarov File Added: TimeSpan.pp
2019-07-23 11:03 Serge Anvarov File Added: TimeSpan-2.pp
2019-07-23 11:03 Serge Anvarov Note Added: 0117351
2019-07-23 11:04 Serge Anvarov Note Edited: 0117351 View Revisions
2019-07-23 12:58 Marco van de Voort File Deleted: TimeSpan.pp
2019-07-23 14:30 Thaddy de Koning Note Added: 0117352
2019-07-23 14:35 Thaddy de Koning Note Edited: 0117352 View Revisions
2019-07-23 14:55 rd0x Note Added: 0117353