PIP-0009: RandomHash delphi compatibility

.gitignore

@@ -34,4 +34,5 @@ Run*.bat
 bin/
 
 ## Delphi files
-__history/
+__history/
+dunit.ini

src/core/URandomHash.pas

@@ -106,7 +106,7 @@ type
       FMurmurHash3_x86_32 : IHash;
       FHashAlg : array[0..17] of IHash;  // declared here to avoid race-condition during mining
       function ContencateByteArrays(const AChunk1, AChunk2: TBytes): TBytes; inline;
-      function MemTransform1(const AChunk: TBytes): TBytes; inline;
+      function MemTransform1(const AChunk: TBytes): TBytes; {$IFDEF FPC}inline;{$ENDIF}
       function MemTransform2(const AChunk: TBytes): TBytes; inline;
       function MemTransform3(const AChunk: TBytes): TBytes; inline;
       function MemTransform4(const AChunk: TBytes): TBytes; inline;
@@ -329,7 +329,7 @@ var
   i, LChunkLength : UInt32;
   LState : UInt32;
 
-  function XorShift32 : UInt32; inline;
+  function XorShift32 : UInt32; {$IFDEF FPC}inline;{$ENDIF}
   begin
     LState := LState XOR (LState SHL 13);
     LState := LState XOR (LState SHR 17);

src/libraries/pascalcoin/UUnitTests.pas

@@ -7,7 +7,7 @@ unit UUnitTests;
 interface
 
 uses
-  Classes, SysUtils, {$IFDEF FPC}fpcunit,testregistry {$ELSE}TestFramework{$ENDIF FPC}, variants;
+  Classes, SysUtils, {$IFDEF FPC}fpcunit,testregistry {$ELSE}DUnitX.TestFramework, DUnitX.DUnitCompatibility{$ENDIF FPC}, variants;
 
 type
 
@@ -46,14 +46,22 @@ begin
     Result := TEncoding.ASCII.GetBytes(AStr);
 end;
 
-class procedure TPascalCoinUnitTest.AssertEquals(const AMessage: string; const Expected, Actual: TBytes); overload;
+class procedure TPascalCoinUnitTest.AssertEquals(const AMessage: string; const Expected, Actual: TBytes);
 begin
+{$IFDEF FPC}
   AssertTrue(AMessage, BytesCompare(Expected, Actual) = 0, CallerAddr);
+{$ELSE}
+  Assert.IsTrue(BytesCompare(Expected, Actual) = 0, AMessage);
+{$ENDIF}
 end;
 
-class procedure TPascalCoinUnitTest.AssertEquals(const Expected, Actual: TBytes); overload;
+class procedure TPascalCoinUnitTest.AssertEquals(const Expected, Actual: TBytes);
 begin
+{$IFDEF FPC}
   AssertEquals(ComparisonMsg(Bytes2Hex(Expected, True), Bytes2Hex(Actual, True)), Expected, Actual);
+{$ELSE}
+  AssertEquals('TODO', Expected, Actual);
+{$ENDIF}
 end;
 
 end.

src/libraries/sphere10/UCommon.Collections.pas

@@ -13,9 +13,10 @@
 
 unit UCommon.Collections;
 
-{$mode delphi}
-
-{$modeswitch nestedprocvars}
+{$IFDEF FPC}
+  {$mode delphi}
+  {$modeswitch nestedprocvars}
+{$endif}
 
 interface
 

src/libraries/sphere10/UCommon.pas

@@ -20,7 +20,8 @@ interface
 
 uses
   Classes, SysUtils, Generics.Collections, Generics.Defaults,
-  Variants, LazUTF8, math, typinfo, UMemory, ExtCtrls;
+  {$IFNDEF FPC}System.Types, System.TimeSpan,{$ENDIF} Variants,
+  {$IFDEF FPC}LazUTF8,{$ENDIF} math, typinfo, UMemory, ExtCtrls;
 
 { CONSTANTS }
 
@@ -56,8 +57,10 @@ function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: string)
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: TObject): TObject; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: variant): variant; overload;
 
+{$IFDEF FPC}
 function GetSetName(const aSet:PTypeInfo; Value: Integer):string;
 function GetSetValue(const aSet:PTypeInfo; Name: String): Integer;
+{$ENDIF}
 
 { Clip/Min/Max Value }
 function ClipValue( AValue, MinValue, MaxValue: Integer) : Integer;
@@ -70,6 +73,11 @@ function UtcTimeStamp : String;
 
 type
 
+  {$IFNDEF FPC}
+  // Delphi compatibility
+  SizeInt = NativeInt;
+  {$ENDIF}
+
   {$IFDEF FPC}
 
   { TTimeSpan }
@@ -91,6 +99,9 @@ type
       function GetTotalSeconds: Double;
       function GetTotalMilliseconds: Double;
       class function Normalize(const ADateTime : TDateTime) : Int64; inline; static;
+      class function GetMinValue : TTimeSpan; static; inline; // cannot be var due to FPC bug
+      class function GetMaxValue : TTimeSpan; static; inline; // cannot be var due to FPC bug
+      class function GetZeroValue : TTimeSpan; static; inline; // cannot be var due to FPC bug
     public
       constructor Create(Hours, Minutes, Seconds: Integer); overload;
       constructor Create(Days, Hours, Minutes, Seconds: Integer); overload;
@@ -133,6 +144,9 @@ type
       property TotalMinutes: Double read GetTotalMinutes;
       property TotalSeconds: Double read GetTotalSeconds;
       property TotalMilliseconds: Double read GetTotalMilliseconds;
+      class property MinValue: TTimeSpan read GetMinValue;
+      class property MaxValue: TTimeSpan read GetMaxValue;
+      class property ZeroValue: TTimeSpan read GetZeroValue;
     end;
 
   {$ENDIF}
@@ -143,7 +157,8 @@ type
     private
       FValue : T;
     public
-      Instances: Integer; static;
+      class var Instances: Integer;
+    public
       property Value : T read FValue write FValue;
       class constructor Create;
       constructor Create(const AValue : T); overload;
@@ -314,7 +329,7 @@ type
       class function Create(const item0 : T; const item1 : T; const item2 : T; const item3 : T) : TArray<T>; overload; static;
       class function Create(const item0 : T; const item1 : T; const item2 : T; const item3 : T; const item4 : T) : TArray<T>; overload; static;
       class function Create(const item0 : T; const item1 : T; const item2 : T; const item3 : T; const item4 : T; const item5 : T) : TArray<T>; overload; static;
-      class function _Length(const Values: array of T) : SizeInt; static; inline;
+      class function _Length(const Values: array of T) : SizeInt; static; {$IFDEF FPC}inline;{$endif}
       class function ToArray(Enumerable: TEnumerable<T>; Count: SizeInt): TArray<T>; static;
   end;
 
@@ -322,7 +337,9 @@ type
 
   TVariantTool = class
     public
-      class function IsNumeric(const AValue : Variant) : boolean;
+      class function IsBool(const AValue : Variant) : boolean; inline;
+      class function IsNumeric(const AValue : Variant) : boolean; inline;
+      class function CompareVariant(const ALeft, ARight : Variant) : Integer; inline;
       class function TryParseBool(const AValue : Variant; out ABoolean : boolean) : boolean;
       class function VarToInt(const AVariant: Variant): integer;
       class function MatchTextExact(const AValue, AMatch : Variant) : boolean;
@@ -338,19 +355,20 @@ type
       class function NumericBetweenExclusive(const AValue, Lower, Upper : Variant) : boolean;
   end;
 
+  { TFileStreamHelper }
+
+  TFileStreamHelper = class helper for TFileStream
+    {$IFNDEF FPC}
+    procedure WriteAnsiString(const AString : String);
+    {$ENDIF}
+  end;
+
   { TFileTool }
 
   TFileTool = class
     class procedure AppendText(const AFileName: string; const AText: string);
   end;
 
-{ COMPLEX CONSTANTS }
-
-const
-    MinTimeSpan : TTimeSpan = (FMillis: Low(Int64));
-    MaxTimeSpan: TTimeSpan = (FMillis: High(Int64));
-    ZeroTimeSpan: TTimeSpan = (FMillis: 0);
-
 resourcestring
   sNotImplemented = 'Not implemented';
   sInvalidParameter_OutOfBounds = 'Invalid Parameter: %s out of bounds';
@@ -370,6 +388,12 @@ const
     LongTimeFormat : 'hh:nn:zzz'
   );
 
+  {$IFDEF FPC}
+  MinTimeSpan : TTimeSpan = (FMillis: Low(Int64));
+  MaxTimeSpan: TTimeSpan = (FMillis: High(Int64));
+  ZeroTimeSpan: TTimeSpan = (FMillis: 0);
+  {$ENDIF}
+
 { VARIABLES }
 
 var
@@ -569,6 +593,22 @@ begin
   Result := MilliSecondsBetween(ADateTime, MinDateTime);
 end;
 
+class function TTimeSpan.GetMinValue : TTimeSpan;
+begin
+  Result := MinTimeSpan;
+end;
+
+class function TTimeSpan.GetMaxValue : TTimeSpan; static; inline;
+begin
+  Result := MaxTimeSpan;
+end;
+
+class function TTimeSpan.GetZeroValue : TTimeSpan; static; inline;
+begin
+  Result := ZeroValue;
+end;
+
+
 constructor TTimeSpan.Create(Hours, Minutes, Seconds: Integer);
 begin
   Self.FMillis := (Hours*MillisPerHour) + (Minutes*MillisPerMinute) + (Seconds*MillisPerSecond);
@@ -796,6 +836,8 @@ begin
     Result := AFalseResult;
 end;
 
+{$IFDEF FPC}
+
 { Enums }
 
 function GetSetName(const aSet:PTypeInfo; Value: Integer):string;
@@ -837,6 +879,8 @@ begin
   end;
 end;
 
+{$ENDIF}
+
 { Clip/Min/Max Value }
 
 function ClipValue( AValue, MinValue, MaxValue: Integer) : Integer;
@@ -1576,24 +1620,42 @@ end;
 
 {%region TVariantTool}
 
+class function TVariantTool.IsBool(const AValue : Variant) : boolean;
+begin
+{$IFDEF FPC}
+  Result := VarIsBool(AValue);
+{$ELSE}
+  Result := VarIsType(AValue, VarBoolean);
+{$ENDIF}
+end;
+
 class function TVariantTool.IsNumeric(const AValue : Variant) : boolean;
 begin
   // VarIsNumeric seems to be broken
   case VarType(AValue) of
     varsmallint, varinteger, varsingle,
-    vardouble, varcurrency, varboolean, vardecimal,
-    varshortint, varbyte, varword, varlongword, varint64, varqword : Result := true;
+    vardouble, varcurrency, varboolean, {$IFDEF FPC}vardecimal,{$ENDIF}
+    varshortint, varbyte, varword, varlongword, varint64 {$IFDEF FPC},varqword {$ENDIF} : Result := true;
     else Result := false;
   end;
 end;
 
+class function TVariantTool.CompareVariant(const ALeft, ARight : Variant) : Integer;
+begin
+{$IFDEF FPC}
+  Result := TCompare.Variant(@ALeft, @ARight);
+{$ELSE}
+  Result := Integer(VarCompareValue(ALeft, ARight));
+{$ENDIF}
+end;
+
 class function TVariantTool.TryParseBool(const AValue : Variant; out ABoolean : boolean) : boolean;
 var
   AValueStr : string;
 begin
   ABoolean := false;
   Result := false;
-  if VarIsBool(AValue) then begin
+  if IsBool(AValue) then begin
     ABoolean := Boolean(AValue);
     Result := true;
   end else if VarIsNumeric(AValue) then
@@ -1649,31 +1711,31 @@ begin
   if NOT IsNumeric(AValue) then
     Exit(false);
 
-  IF VarIsBool(AValue) then begin
+  IF IsBool(AValue) then begin
     if TryParseBool(AMatch, bmatch) then begin
       Result := (Boolean(AValue) = bmatch);
     end else begin
       Result := false;
       end
   end else begin
-    Result := TCompare.Variant(@AValue, @AMatch) = 0;
+    Result := CompareVariant(AValue, AMatch) = 0;
   end;
 end;
 
 class function TVariantTool.NumericLT(const AValue, AMatch : Variant) : boolean;
 begin
-  if (NOT IsNumeric(AValue)) OR (VarIsBool(AValue)) then
+  if (NOT IsNumeric(AValue)) OR (IsBool(AValue)) then
     Exit(false);
-  Result := TCompare.Variant(@AValue, @AMatch) = -1;
+  Result := CompareVariant(AValue, AMatch) = -1;
 end;
 
 class function TVariantTool.NumericLTE(const AValue, AMatch : Variant) : boolean;
 var
   cmp : Integer;
 begin
-  if (NOT IsNumeric(AValue)) OR (VarIsBool(AValue)) then
+  if (NOT IsNumeric(AValue)) OR (IsBool(AValue)) then
     Exit(false);
-  cmp := TCompare.Variant(@AValue, @AMatch);
+  cmp := CompareVariant(AValue, AMatch);
   Result := (cmp = -1) OR (cmp = 0);
 end;
 
@@ -1681,9 +1743,9 @@ class function TVariantTool.NumericGT(const AValue, AMatch : Variant) : boolean;
 var
   cmp : Integer;
 begin
-  if (NOT IsNumeric(AValue)) OR (VarIsBool(AValue)) then
+  if (NOT IsNumeric(AValue)) OR (IsBool(AValue)) then
     Exit(false);
-  cmp := TCompare.Variant(@AValue, @AMatch);
+  cmp := CompareVariant(AValue, AMatch);
   Result := (cmp = 1);
 end;
 
@@ -1691,9 +1753,9 @@ class function TVariantTool.NumericGTE(const AValue, AMatch : Variant) : boolean
 var
   cmp : Integer;
 begin
-  if (NOT IsNumeric(AValue)) OR (VarIsBool(AValue)) then
+  if (NOT IsNumeric(AValue)) OR (IsBool(AValue)) then
     Exit(false);
-  cmp := TCompare.Variant(@AValue, @AMatch);
+  cmp := CompareVariant(AValue, AMatch);
   Result := (cmp = 1) OR (cmp = 0);
 end;
 
@@ -1701,10 +1763,10 @@ class function TVariantTool.NumericBetweenInclusive(const AValue, Lower, Upper :
 var
   lowercmp, uppercmp : Integer;
 begin
-  if (NOT IsNumeric(AValue)) OR (VarIsBool(AValue)) then
+  if (NOT IsNumeric(AValue)) OR (IsBool(AValue)) then
     Exit(false);
-  lowercmp := TCompare.Variant(@AValue, @Lower);
-  uppercmp := TCompare.Variant(@AValue, @Upper);
+  lowercmp := CompareVariant(AValue, Lower);
+  uppercmp := CompareVariant(AValue, Upper);
   Result := ((lowercmp = 1) OR (lowercmp = 0)) AND ((uppercmp = -1) OR (uppercmp = 0));
 end;
 
@@ -1714,13 +1776,24 @@ var
 begin
   if NOT IsNumeric(AValue) then
     Exit(false);
-  lowercmp := TCompare.Variant(@AValue, @Lower);
-  uppercmp := TCompare.Variant(@AValue, @Upper);
+  lowercmp := CompareVariant(AValue, Lower);
+  uppercmp := CompareVariant(AValue, Upper);
   Result := (lowercmp = 1) AND (uppercmp = -1);
 end;
 
 {%endregion}
 
+
+{ TFileStreamHelper }
+{$IFNDEF FPC}
+procedure TFileStreamHelper.WriteAnsiString(const AString : String);
+begin
+   Self.WriteBuffer(Pointer(AString)^, Length(AString));
+end;
+{$ENDIF}
+
+
+
 {%region TFileTool }
 
 class procedure TFileTool.AppendText(const AFileName: string; const AText: string);
@@ -1743,6 +1816,7 @@ end;
 
 {%endregion}
 
+
 initialization
   MinTimeStampDateTime:= StrToDateTime('1980-01-01 00:00:000', IntlDateTimeFormat);
   VarTrue := True;

src/tests/RandomHash.Tests.dpr

@@ -1,14 +1,4 @@
 program RandomHash.Tests;
-{
-
-  Delphi DUnit Test Project
-  -------------------------
-  This project contains the DUnit test framework and the GUI/Console test runners.
-  Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options
-  to use the console test runner.  Otherwise the GUI test runner will be used by
-  default.
-
-}
 
 {$WARN DUPLICATE_CTOR_DTOR OFF}
 {$IFDEF CONSOLE_TESTRUNNER}
@@ -17,14 +7,14 @@ program RandomHash.Tests;
 
 uses
   Forms,
-  TestFramework,
+  DUnitX.TestFramework, DUnitX.DUnitCompatibility,
   GUITestRunner,
   TextTestRunner,
   URandomHash in '..\core\URandomHash.pas',
-  RandomHashTests in 'RandomHashTests.pas';
+  URandomHashTests.Delphi in 'URandomHashTests.Delphi.pas';
 
 begin
-Application.Initialize;
+  Application.Initialize;
   if IsConsole then
     TextTestRunner.RunRegisteredTests
   else

src/tests/URandomHashTests.Delphi.pas

@@ -0,0 +1,57 @@
+unit URandomHashTests.Delphi;
+
+interface
+
+uses
+  Classes, SysUtils, {$IFDEF FPC}fpcunit,testregistry {$ELSE}DUnitX.TestFramework, DUnitX.DUnitCompatibility{$ENDIF FPC},
+  UUnitTests, HlpIHash;
+
+type
+
+  { TRandomHashTest }
+
+  [TestFixture]
+  TRandomHashTest = class(TPascalCoinUnitTest)
+  public
+    [TestCase]
+    procedure TestRandomHash_Standard;
+  end;
+
+implementation
+
+uses variants, UCommon, UMemory, URandomHash, HlpHashFactory, HlpBitConverter, strutils;
+
+const
+
+  { RandomHash Official Values }
+
+  DATA_RANDOMHASH_STANDARD_INPUT : array[1..3] of String = (
+    '0x0',
+    'The quick brown fox jumps over the lazy dog',
+    '0x000102030405060708090a0b0c0d0e0f'
+  );
+
+  DATA_RANDOMHASH_STANDARD_EXPECTED : array[1..3] of String = (
+    '0x291ef6d7f9babe3d2d4fd6560c7eefc7a9937126fd13d5af6fd0474b6dfac215',
+    '0xf0803f016666d6a236701ade96fdc48a23d9eaa8c03097e5e9f690b5142b2537',
+    '0x3cc5de8f601ce1ec7adbd765884d6c0f486de4c3a535a36a8658253edb2a80f3'
+  );
+
+
+{ TRandomHashTest }
+
+procedure TRandomHashTest.TestRandomHash_Standard;
+var
+  i : integer;
+begin
+  for i := Low(DATA_RANDOMHASH_STANDARD_INPUT) to High(DATA_RANDOMHASH_STANDARD_INPUT) do
+    AssertEquals(ParseBytes(DATA_RANDOMHASH_STANDARD_EXPECTED[i]), TRandomHash.Compute(ParseBytes(DATA_RANDOMHASH_STANDARD_INPUT[i])));
+    //WriteLn(Format('%s', [Bytes2Hex(TRandomHash.Compute(ParseBytes(LCase.Input)), True)]));
+end;
+
+
+initialization
+
+  TDUnitX.RegisterTestFixture(TRandomHashTest);
+
+end.