pas2js/test/tcsyshelpers.pp
2020-04-26 21:06:49 +00:00

1249 lines
36 KiB
ObjectPascal

unit tcsyshelpers;
{$mode objfpc}{$h+}
interface
uses
SysUtils, fpcunit, testregistry;
Type
{ TTestHelpers }
TTestHelpers = class(TTestCase)
private
procedure EqualGUID(Msg: String; Expected, Actual: TGUID);
procedure EqualGUIDSwap(Msg: String; Expected, Actual: TGUID);
procedure GetGUID(out G: TGUID);
Published
// Public
procedure TestGUIDHelperCreateUntypedData;
procedure TestGUIDHelperCreateUntypedDataEndian;
procedure TestGUIDHelperCreateInteger;
procedure TestGUIDHelperCreateIntegerBytes;
procedure TestGUIDHelperCreateNew;
procedure TestGUIDHelperCreateString;
procedure TestGUIDHelperCreateTBytes;
procedure TestGUIDHelperCreateTBytesAtIndex;
procedure TestGUIDHelperCreateWords;
procedure TestGUIDHelperToByteArray;
procedure TestGUIDHelperToString;
procedure TestByteHelper;
procedure TestCardinalHelper;
procedure TestLongintHelper;
procedure TestNegLongintHelper;
procedure TestNegShortIntHelper;
procedure TestNegSmallintHelper;
procedure TestShortIntHelper;
procedure TestSmallintHelper;
procedure TestWordHelper;
procedure TestIsNanDouble;
procedure TestByteClearBit;
procedure TestByteSetBit;
procedure TestByteTestBit;
procedure TestByteToggleBit;
procedure TestShortIntSetBit;
procedure TestShortIntToggleBit;
procedure TestCardinalClearBit;
procedure TestCardinalSetBit;
procedure TestCardinalTestBit;
procedure TestCardinalToggleBit;
procedure TestLongintClearBit;
procedure TestLongintSetBit;
procedure TestLongintTestBit;
procedure TestLongintToggleBit;
procedure TestShortIntClearBit;
procedure TestShortIntTestBit;
procedure TestSmallIntClearBit;
procedure TestSmallIntSetBit;
procedure TestSmallIntTestBit;
procedure TestSmallIntToggleBit;
procedure TestWordClearBit;
procedure TestWordSetBit;
procedure TestWordTestBit;
procedure TestWordToggleBit;
procedure TestNativeUintSetBit;
procedure TestNativeUIntToggleBit;
procedure TestNativeIntHelper;
procedure TestNativeUintHelper;
procedure TestNativeUIntTestBit;
procedure TestNativeIntClearBit;
procedure TestNativeIntSetBit;
procedure TestNativeIntToggleBit;
procedure TestNativeIntTestBit;
end;
Implementation
Procedure TTestHelpers.TestByteHelper;
Const
Value = 123;
ValueAsString = '123';
ValueAsHex = '7B';
ValueAsHexDig = 4;
ValueAsHexDigString = '007B';
Var
V : Byte;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestShortIntHelper;
Const
Value = 123;
ValueAsString = '123';
ValueAsHex = '7B';
ValueAsHexDig = 4;
ValueAsHexDigString = '007B';
Var
V : ShortInt;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestNegShortIntHelper;
Const
Value = -123;
ValueAsString = '-123';
ValueAsHex = '85';
ValueAsHexDig = 4;
ValueAsHexDigString = 'FF85';
Var
V : ShortInt;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestWordHelper;
Const
Value = 1024;
ValueAsString = '1024';
ValueAsHex = '0400';
ValueAsHexDig = 6;
ValueAsHexDigString = '000400';
Var
V : Word;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestSmallintHelper;
Const
Value = 1024;
ValueAsString = '1024';
ValueAsHex = '0400';
ValueAsHexDig = 6;
ValueAsHexDigString = '000400';
Var
V : Smallint;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestNegSmallintHelper;
Const
Value = -1024;
ValueAsString = '-1024';
ValueAsHex = 'FC00';
ValueAsHexDig = 6;
ValueAsHexDigString = 'FFFC00';
Var
V : Smallint;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestCardinalHelper;
Const
Value = 131072;
ValueAsString = '131072';
ValueAsHex = '00020000';
ValueAsHexDig = 10;
ValueAsHexDigString = '0000020000';
Var
V : Cardinal;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestLongintHelper;
Const
Value = 131072;
ValueAsString = '131072';
ValueAsHex = '00020000';
ValueAsHexDig = 10;
ValueAsHexDigString = '0000020000';
Var
V : Longint;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestNegLongintHelper;
Const
Value = -131072;
ValueAsString = '-131072';
ValueAsHex = 'FFFE0000';
ValueAsHexDig = 10;
ValueAsHexDigString = '00FFFE0000';
Var
V : Longint;
begin
{$i tohelper.inc}
end;
Procedure TTestHelpers.TestNativeUintHelper;
Const
Value = 17179869184; // 2^34
ValueAsString = '17179869184';
ValueAsHex = '0000000400000000';
ValueAsHexDig = 18;
ValueAsHexDigString = '000000000400000000';
Var
V : NativeUInt;
begin
Fail('Not implemented yet');
// {$i tohelper.inc}
end;
Procedure TTestHelpers.TestNativeIntHelper;
Const
Value = 17179869184; // 2^34
ValueAsString = '17179869184';
ValueAsHex = '0000000400000000';
ValueAsHexDig = 18;
ValueAsHexDigString = '000000000400000000';
Var
V : NativeInt;
begin
Fail('Notimplemented');
// {$i tohelper.inc}
end;
Procedure TTestHelpers.GetGUID(out G : TGUID);
Var
I : Integer;
begin
G.D1:=$DDCCBBAA;
G.D2:=$EEFF;
G.D3:=$CAAC;
For I:=0 to 7 do
G.D4[i]:=(1 shl i) and $FF;
end;
Procedure TTestHelpers.EqualGUID(Msg : String;Expected,Actual : TGUID);
Var
I : Integer;
begin
AssertEquals(Msg+' D1 equal',Expected.D1,Actual.D1);
AssertEquals(Msg+' D2 equal',Expected.D2,Actual.D2);
AssertEquals(Msg+' D2 equal',Expected.D3,Actual.D3);
For I:=0 to 7 do
AssertEquals(Msg+' D4['+IntToStr(I)+'] equal',Expected.D4[i],Actual.D4[i]);
end;
Procedure TTestHelpers.EqualGUIDSwap(Msg : String;Expected,Actual : TGUID);
Var
I : Integer;
begin
AssertEquals(Msg+' D1 equal',SwapEndian(Expected.D1),Actual.D1);
AssertEquals(Msg+' D2 equal',SwapEndian(Expected.D2),Actual.D2);
AssertEquals(Msg+' D2 equal',SwapEndian(Expected.D3),Actual.D3);
For I:=0 to 7 do
AssertEquals(Msg+' D4['+IntToStr(I)+'] equal',Expected.D4[i],Actual.D4[i]);
end;
Procedure TTestHelpers.TestGUIDHelperCreateUntypedData;
Var
Src,Dest : TGUID;
begin
GetGUID(Src);
Dest:=TGUID.Create(Src, True);
if CPUEndian = TEndian.Big then
EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
else
EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
Dest:=TGUID.Create(Src, False);
if CPUEndian = TEndian.Big then
EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
else
EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
end;
Procedure TTestHelpers.TestGUIDHelperCreateUntypedDataEndian;
Var
Src,Dest : TGUID;
begin
GetGUID(Src);
Dest:=TGUID.Create(Src, True);
if CPUEndian = TEndian.Big then
EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
else
EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
Dest:=TGUID.Create(Src, False);
if CPUEndian = TEndian.Big then
EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
else
EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
end;
Procedure TTestHelpers.TestGUIDHelperCreateTBytes;
Var
Src,Dest : TGUID;
SrcBytes : TBytes;
D,I : Cardinal;
begin
GetGUID(Src);
SrcBytes:=[];
SetLength(SrcBytes,16);
D:=Src.D1;
SrcBytes[0]:=D shr 24;
SrcBytes[1]:=(D shr 16) and $FF;
SrcBytes[2]:=(D shr 8) and $FF;
SrcBytes[3]:=(D and $FF);
D:=Src.D2;
SrcBytes[4]:=(D shr 8) and $FF;
SrcBytes[5]:=(D and $FF);
D:=Src.D3;
SrcBytes[6]:=(D shr 8) and $FF;
SrcBytes[7]:=(D and $FF);
For I:=0 to 7 do
SrcBytes[8+i]:=Src.D4[i];
Dest:=TGUID.Create(SrcBytes, TEndian.Big);
if CPUEndian = TEndian.Big then
EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
else
EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
Dest:=TGUID.Create(SrcBytes, TEndian.Little);
if CPUEndian = TEndian.Big then
EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
else
EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
end;
Procedure TTestHelpers.TestGUIDHelperCreateTBytesAtIndex;
Var
Src,Dest : TGUID;
SrcBytes : TBytes;
I,D : Cardinal;
begin
GetGUID(Src);
SrcBytes:=[];
SetLength(SrcBytes,32);
D:=Src.D1;
SrcBytes[4]:=D shr 24;
SrcBytes[5]:=(D shr 16) and $FF;
SrcBytes[6]:=(D shr 8) and $FF;
SrcBytes[7]:=(D and $FF);
D:=Src.D2;
SrcBytes[8]:=(D shr 8) and $FF;
SrcBytes[9]:=(D and $FF);
D:=Src.D3;
SrcBytes[10]:=(D shr 8) and $FF;
SrcBytes[11]:=(D and $FF);
For I:=0 to 7 do
SrcBytes[12+i]:=Src.D4[i];
Dest:=TGUID.Create(SrcBytes, 4, TEndian.Big);
if CPUEndian = TEndian.Big then
EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
else
EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
Dest:=TGUID.Create(SrcBytes, 4, TEndian.Little);
if CPUEndian = TEndian.Big then
EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
else
EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
end;
Procedure TTestHelpers.TestGUIDHelperCreateString;
Var
Src,Dest : TGUID;
begin
GetGUID(Src);
Dest:=TGUID.Create(GUIDToString(Src));
EqualGUID('Check equals',Src,Dest);
end;
Procedure TTestHelpers.TestGUIDHelperCreateIntegerBytes;
// Class Function Create(A: Integer; B: SmallInt; C: SmallInt; const D: TBytes): TGUID; overload; static;
Var
A,I : Integer;
B,C : Smallint;
D : TBytes;
Dest : TGUID;
begin
A:=1;
B:=2;
C:=3;
D:=Nil;
SetLength(D,8);
For I:=0 to 7 do
D[i]:=4+I;
Dest:=TGuid.Create(A,B,C,D);
AssertEquals('D1',1,Dest.D1);
AssertEquals('D2',2,Dest.D2);
AssertEquals('D3',3,Dest.D3);
For I:=0 to 7 do
AssertEquals('D4['+IntToStr(i)+']',I+4,Dest.D4[i]);
end;
Procedure TTestHelpers.TestGUIDHelperCreateWords;
// Class Function Create(A: Cardinal; B: Word; C: Word; D, E, F, G, H, I, J, K: Byte): TGUID; overload; static;
Var
A,I : Cardinal;
B,C : Word;
Dest : TGUID;
begin
A:=1;
B:=Word($FFFE);
C:=Word($FFFF);
Dest:=TGuid.Create(A,B,C,4,5,6,7,8,9,10,11);
AssertEquals('D1',1,Dest.D1);
AssertEquals('D2',$FFFE,Dest.D2);
AssertEquals('D3',$FFFF,Dest.D3);
For I:=0 to 7 do
AssertEquals('D4['+IntToStr(i)+']',I+4,Dest.D4[i]);
end;
Procedure TTestHelpers.TestGUIDHelperCreateInteger;
// Class Function Create(A: Integer; B: SmallInt; C: SmallInt; D, E, F, G, H, I, J, K: Byte): TGUID; overload; static;
Var
A,I : Integer;
B,C : Smallint;
Dest : TGUID;
begin
A:=1;
B:=Smallint($FFFE);
C:=Smallint($FFFF);
Dest:=TGuid.Create(A,B,C,4,5,6,7,8,9,10,11);
AssertEquals('D1',1,Dest.D1);
AssertEquals('D2',$FFFE,Dest.D2);
AssertEquals('D3',$FFFF,Dest.D3);
For I:=0 to 7 do
AssertEquals('D4['+IntToStr(i)+']',I+4,Dest.D4[i]);
end;
Procedure TTestHelpers.TestGUIDHelperCreateNew;
// Class Function NewGuid: TGUID; static;
Var
Src,Dest : TGuid;
I,J : integer;
begin
// All we can do is check that you don't get the same GUID twice.
Src:=TGuid.NewGuid;
Dest:=TGuid.NewGuid;
I:=0;
Inc(I,Ord(Src.D1<>Dest.D1));
Inc(I,Ord(Src.D2<>Dest.D2));
Inc(I,Ord(Src.D3<>Dest.D3));
For J:=0 to 7 do
Inc(I,Ord(Src.D4[i]<>Dest.D4[i]));
AssertTrue('D1<>D2',I>0);
end;
Procedure TTestHelpers.TestGUIDHelperToByteArray;
Var
Src,Dest : TGuid;
D : TBytes;
begin
// All we can do is check that you don't get the same GUID twice.
Src:=TGuid.NewGuid;
D:=Src.ToByteArray(CPUEndian);
Dest:=TGUID.Create(D,CPUEndian);
EqualGUID('Check equals',Src,Dest);
if CPUEndian=TEndian.Big then
Dest:=TGUID.Create(D,TEndian.Little)
else
Dest:=TGUID.Create(D,TEndian.Big);
EqualGUIDSwap('Swapped, Check equals',Src,Dest);
end;
Procedure TTestHelpers.TestGUIDHelperToString;
// Function ToString: string;
Var
Src : TGuid;
S : String;
begin
CreateGUID(Src);
S:=GuidToString(Src);
AssertEquals('Equal',S,Src.ToString);
Delete(S,1,1);
Delete(S,Length(S),1);
AssertEquals('Equal',S,Src.ToString(True));
end;
Procedure TTestHelpers.TestIsNanDouble;
var
Value: Double;
begin
asm
Value = Number.NaN; // Double.NaN;
end;
AssertEquals('Is Nan',True,Value.IsNan);
end;
Procedure TTestHelpers.TestByteSetBit;
var
Index: TByteBitIndex;
B: Byte;
const
Expected: array[TByteBitIndex] of byte = ($01,$03,$07,$0F,$1F,$3F,$7F,$FF);
begin
// writeln('TestByteSetBit Start');
B := 0;
for Index in TByteBitIndex do
begin
B.SetBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],B);
end;
// writeln('TestByteSetBit: OK');
end;
Procedure TTestHelpers.TestByteToggleBit;
var
Index: TByteBitIndex;
B: Byte;
const
Expected: array[TByteBitIndex] of byte = ($01,$03,$07,$0F,$1F,$3F,$7F,$FF);
begin
// writeln('TestByteToggleBit Start');
B := 0;
for Index in TByteBitIndex do
begin
B.ToggleBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],B);
end;
// writeln('TestByteToggleBit: OK');
end;
Procedure TTestHelpers.TestByteClearBit;
var
Index: TByteBitIndex;
B: Byte;
const
Expected: array[TByteBitIndex] of byte = ($FE,$FD,$FB,$F7,$EF,$DF,$BF,$7F);
begin
// writeln('TestByteClearBit Start');
for Index in TByteBitIndex do
begin
B := High(Byte);
B.ClearBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],B);
end;
// writeln('TestByteClearBit: OK');
end;
Procedure TTestHelpers.TestByteTestBit;
var
Index: TByteBitIndex;
B: Byte;
const
Expected: array[TByteBitIndex] of Boolean = (True,False,True,False,True,False,True,False);
begin
// writeln('TestByteTestBit Start');
B := $55;
for Index in TByteBitIndex do
AssertEquals('Bit '+IntToStr(Index),Expected[Index],B.TestBit(Index));
// writeln('TestByteTestBit: OK');
end;
Procedure TTestHelpers.TestShortIntSetBit;
var
Index: TShortIntBitIndex;
S: ShortInt;
const
Expected: array[TByteBitIndex] of ShortInt = (
ShortInt($01),ShortInt($03),ShortInt($07),ShortInt($0F),
ShortInt($1F),ShortInt($3F),ShortInt($7F),ShortInt($FF));
begin
// writeln('TestShortIntSetBit Start');
S := 0;
for Index in TShortIntBitIndex do
begin
S.SetBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],S);
end;
// writeln('TestShortIntSetBit: OK');
end;
Procedure TTestHelpers.TestShortIntToggleBit;
var
Index: TShortIntBitIndex;
S: ShortInt;
const
Expected: array[TByteBitIndex] of ShortInt = (
ShortInt($01),ShortInt($03),ShortInt($07),ShortInt($0F),
ShortInt($1F),ShortInt($3F),ShortInt($7F),ShortInt($FF));
begin
// writeln('TestShortIntToggleBit Start');
S := 0;
for Index in TShortIntBitIndex do
begin
S.ToggleBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],S);
end;
// writeln('TestShortIntToggleBit: OK');
end;
Procedure TTestHelpers.TestShortIntClearBit;
var
Index: TShortIntBitIndex;
S: ShortInt;
const
Expected: array[TByteBitIndex] of ShortInt = (
ShortInt($FE),ShortInt($FD),ShortInt($FB),ShortInt($F7),
ShortInt($EF),ShortInt($DF),ShortInt($BF),ShortInt($7F));
begin
// writeln('TestShortIntClearBit Start');
for Index in TShortIntBitIndex do
begin
S := ShortInt($FF);
S.ClearBit(Index);// was Togglebit ?
AssertEquals('Bit '+IntToStr(Index),Expected[Index],S);
end;
// writeln('TestShortIntClearBit: OK');
end;
Procedure TTestHelpers.TestShortIntTestBit;
var
Index: TShortIntBitIndex;
S: ShortInt;
const
Expected: array[TByteBitIndex] of Boolean = (True,False,True,False,True,False,True,False);
begin
// writeln('TestShortIntTestBit Start');
S := ShortInt($55);
for Index in TShortIntBitIndex do
AssertEquals('Bit '+IntToStr(Index),Expected[Index],S.TestBit(Index));
// writeln('TestShortIntTestBit: OK');
end;
Procedure TTestHelpers.TestWordSetBit;
var
Index: TWordBitIndex;
W: Word;
const
Expected: array[TWordBitIndex] of Word = (
$0001,$0003,$0007,$000F,$001F,$003F,$007F,$00FF,
$01FF,$03FF,$07FF,$0FFF,$1FFF,$3FFF,$7FFF,$FFFF);
begin
// writeln('TestWordSetBit Start');
W := 0;
for Index in TWordBitIndex do
begin
W.SetBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],W);
end;
// writeln('TestWordSetBit: OK');
end;
Procedure TTestHelpers.TestWordToggleBit;
var
Index: TWordBitIndex;
W: Word;
const
Expected: array[TWordBitIndex] of Word = (
$0001,$0003,$0007,$000F,$001F,$003F,$007F,$00FF,
$01FF,$03FF,$07FF,$0FFF,$1FFF,$3FFF,$7FFF,$FFFF);
begin
// writeln('TestWordToggleBit Start');
W := 0;
for Index in TWordBitIndex do
begin
W.ToggleBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],W);
end;
// writeln('TestWordToggleBit: OK');
end;
Procedure TTestHelpers.TestWordClearBit;
var
Index: TWordBitIndex;
W: Word;
const
Expected: array[TWordBitIndex] of Word = (
$FFFE,$FFFD,$FFFB,$FFF7,$FFEF,$FFDF,$FFBF,$FF7F,
$FEFF,$FDFF,$FBFF,$F7FF,$EFFF,$DFFF,$BFFF,$7FFF);
begin
// writeln('TestWordClearBit Start');
for Index in TWordBitIndex do
begin
W := High(Word);
W.ClearBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],W);
end;
// writeln('TestWordClearBit: OK');
end;
Procedure TTestHelpers.TestWordTestBit;
var
Index: TWordBitIndex;
W: Word;
const
Expected: array[TWordBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False);
begin
// writeln('TestWordTestBit Start');
W := $5555;
for Index in TWordBitIndex do
AssertEquals('Bit '+IntToStr(Index),Expected[Index],W.TestBit(Index));
// writeln('TestWordTestBit: OK');
end;
Procedure TTestHelpers.TestSmallIntSetBit;
var
Index: TSmallIntBitIndex;
S: SmallInt;
const
Expected: array[TSmallIntBitIndex] of SmallInt = (
SmallInt($0001),SmallInt($0003),SmallInt($0007),SmallInt($000F),
SmallInt($001F),SmallInt($003F),SmallInt($007F),SmallInt($00FF),
SmallInt($01FF),SmallInt($03FF),SmallInt($07FF),SmallInt($0FFF),
SmallInt($1FFF),SmallInt($3FFF),SmallInt($7FFF),SmallInt($FFFF));
begin
// writeln('TestSmallIntSetBit Start');
S := 0;
for Index in TSmallIntBitIndex do
begin
S.SetBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],S);
end;
// writeln('TestSmallIntSetBit: OK');
end;
Procedure TTestHelpers.TestSmallIntToggleBit;
var
Index: TSmallIntBitIndex;
S: SmallInt;
const
Expected: array[TSmallIntBitIndex] of SmallInt = (
SmallInt($0001),SmallInt($0003),SmallInt($0007),SmallInt($000F),
SmallInt($001F),SmallInt($003F),SmallInt($007F),SmallInt($00FF),
SmallInt($01FF),SmallInt($03FF),SmallInt($07FF),SmallInt($0FFF),
SmallInt($1FFF),SmallInt($3FFF),SmallInt($7FFF),SmallInt($FFFF));
begin
// writeln('TestSmallIntToggleBit Start');
S := 0;
for Index in TSmallIntBitIndex do
begin
S.ToggleBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],S);
end;
// writeln('TestSmallIntToggleBit: OK');
end;
Procedure TTestHelpers.TestSmallIntClearBit;
var
Index: TSmallIntBitIndex;
S: SmallInt;
const
Expected: array[TSmallIntBitIndex] of SmallInt = (
SmallInt($FFFE),SmallInt($FFFD),SmallInt($FFFB),SmallInt($FFF7),
SmallInt($FFEF),SmallInt($FFDF),SmallInt($FFBF),SmallInt($FF7F),
SmallInt($FEFF),SmallInt($FDFF),SmallInt($FBFF),SmallInt($F7FF),
SmallInt($EFFF),SmallInt($DFFF),SmallInt($BFFF),SmallInt($7FFF));
begin
// writeln('TestSmallIntClearBit Start');
for Index in TSmallIntBitIndex do
begin
S := SmallInt($FFFF);
S.ClearBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],S);
end;
// writeln('TestSmallIntClearBit: OK');
end;
Procedure TTestHelpers.TestSmallIntTestBit;
var
Index: TSmallIntBitIndex;
S: SmallInt;
const
Expected: array[TSmallIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False);
begin
// writeln('TestSmallIntTestBit Start');
S := SMallInt($5555);
for Index in TSmallIntBitIndex do
AssertEquals('Bit '+IntToStr(Index),Expected[Index],S.TestBit(Index));
// writeln('TestSmallIntTestBit: OK');
end;
Procedure TTestHelpers.TestCardinalSetBit;
var
Index: TCardinalBitIndex;
C: Cardinal;
const
Expected: array[TCardinalBitIndex] of Cardinal = (
$00000001,$00000003,$00000007,$0000000F,
$0000001F,$0000003F,$0000007F,$000000FF,
$000001FF,$000003FF,$000007FF,$00000FFF,
$00001FFF,$00003FFF,$00007FFF,$0000FFFF,
$0001FFFF,$0003FFFF,$0007FFFF,$000FFFFF,
$001FFFFF,$003FFFFF,$007FFFFF,$00FFFFFF,
$01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,
$1FFFFFFF,$3FFFFFFF,$7FFFFFFF,$FFFFFFFF);
begin
// writeln('TestCardinalSetBit Start');
C := 0;
for Index in TCardinalBitIndex do
begin
C.SetBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],C);
end;
// writeln('TestCardinalSetBit: OK');
end;
Procedure TTestHelpers.TestCardinalToggleBit;
var
Index: TCardinalBitIndex;
C: Cardinal;
const
Expected: array[TCardinalBitIndex] of Cardinal = (
$00000001,$00000003,$00000007,$0000000F,
$0000001F,$0000003F,$0000007F,$000000FF,
$000001FF,$000003FF,$000007FF,$00000FFF,
$00001FFF,$00003FFF,$00007FFF,$0000FFFF,
$0001FFFF,$0003FFFF,$0007FFFF,$000FFFFF,
$001FFFFF,$003FFFFF,$007FFFFF,$00FFFFFF,
$01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,
$1FFFFFFF,$3FFFFFFF,$7FFFFFFF,$FFFFFFFF);
begin
// writeln('TestCardinalToggleBit Start');
C := 0;
for Index in TCardinalBitIndex do
begin
C.ToggleBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],C);
end;
// writeln('TestCardinalToggleBit: OK');
end;
Procedure TTestHelpers.TestCardinalClearBit;
var
Index: TCardinalBitIndex;
C: Cardinal;
const
Expected: array[TCardinalBitIndex] of Cardinal = (
$FFFFFFFE,$FFFFFFFD,$FFFFFFFB,$FFFFFFF7,
$FFFFFFEF,$FFFFFFDF,$FFFFFFBF,$FFFFFF7F,
$FFFFFEFF,$FFFFFDFF,$FFFFFBFF,$FFFFF7FF,
$FFFFEFFF,$FFFFDFFF,$FFFFBFFF,$FFFF7FFF,
$FFFEFFFF,$FFFDFFFF,$FFFBFFFF,$FFF7FFFF,
$FFEFFFFF,$FFDFFFFF,$FFBFFFFF,$FF7FFFFF,
$FEFFFFFF,$FDFFFFFF,$FBFFFFFF,$F7FFFFFF,
$EFFFFFFF,$DFFFFFFF,$BFFFFFFF,$7FFFFFFF);
begin
// writeln('TestCardinalClearBit Start');
for Index in TCardinalBitIndex do
begin
C := High(Cardinal);
C.ClearBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],C);
end;
// writeln('TestCardinalClearBit: OK');
end;
Procedure TTestHelpers.TestCardinalTestBit;
var
Index: TCardinalBitIndex;
C: Cardinal;
const
Expected: array[TCardinalBitIndex] of Boolean = (
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False);
begin
// writeln('TestCardinalTestBit Start');
C := $55555555;
for Index in TCardinalBitIndex do
AssertEquals('Bit '+IntToStr(Index),Expected[Index],C.TestBit(Index));
// writeln('TestCardinalTestBit: OK');
end;
Procedure TTestHelpers.TestLongintSetBit;
var
Index: TLongintBitIndex;
L: Longint;
const
Expected: array[TLongintBitIndex] of Longint = (
Longint($00000001),Longint($00000003),Longint($00000007),Longint($0000000F),
Longint($0000001F),Longint($0000003F),Longint($0000007F),Longint($000000FF),
Longint($000001FF),Longint($000003FF),Longint($000007FF),Longint($00000FFF),
Longint($00001FFF),Longint($00003FFF),Longint($00007FFF),Longint($0000FFFF),
Longint($0001FFFF),Longint($0003FFFF),Longint($0007FFFF),Longint($000FFFFF),
Longint($001FFFFF),Longint($003FFFFF),Longint($007FFFFF),Longint($00FFFFFF),
Longint($01FFFFFF),Longint($03FFFFFF),Longint($07FFFFFF),Longint($0FFFFFFF),
Longint($1FFFFFFF),Longint($3FFFFFFF),Longint($7FFFFFFF),Longint($FFFFFFFF));
begin
// writeln('TestLongintSetBit Start');
L := 0;
for Index in TLongintBitIndex do
begin
L.SetBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],L);
end;
// writeln('TestLongintSetBit: OK');
end;
Procedure TTestHelpers.TestLongintToggleBit;
var
Index: TLongintBitIndex;
L: Longint;
const
Expected: array[TLongintBitIndex] of Longint = (
Longint($00000001),Longint($00000003),Longint($00000007),Longint($0000000F),
Longint($0000001F),Longint($0000003F),Longint($0000007F),Longint($000000FF),
Longint($000001FF),Longint($000003FF),Longint($000007FF),Longint($00000FFF),
Longint($00001FFF),Longint($00003FFF),Longint($00007FFF),Longint($0000FFFF),
Longint($0001FFFF),Longint($0003FFFF),Longint($0007FFFF),Longint($000FFFFF),
Longint($001FFFFF),Longint($003FFFFF),Longint($007FFFFF),Longint($00FFFFFF),
Longint($01FFFFFF),Longint($03FFFFFF),Longint($07FFFFFF),Longint($0FFFFFFF),
Longint($1FFFFFFF),Longint($3FFFFFFF),Longint($7FFFFFFF),Longint($FFFFFFFF));
begin
// writeln('TestLongintToggleBit Start');
L := 0;
for Index in TLongintBitIndex do
begin
L.ToggleBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],L);
end;
// writeln('TestLongintToggleBit: OK');
end;
Procedure TTestHelpers.TestLongintClearBit;
var
Index: TLongintBitIndex;
L: Longint;
const
Expected: array[TLongintBitIndex] of Longint = (
Longint($FFFFFFFE),Longint($FFFFFFFD),Longint($FFFFFFFB),Longint($FFFFFFF7),
Longint($FFFFFFEF),Longint($FFFFFFDF),Longint($FFFFFFBF),Longint($FFFFFF7F),
Longint($FFFFFEFF),Longint($FFFFFDFF),Longint($FFFFFBFF),Longint($FFFFF7FF),
Longint($FFFFEFFF),Longint($FFFFDFFF),Longint($FFFFBFFF),Longint($FFFF7FFF),
Longint($FFFEFFFF),Longint($FFFDFFFF),Longint($FFFBFFFF),Longint($FFF7FFFF),
Longint($FFEFFFFF),Longint($FFDFFFFF),Longint($FFBFFFFF),Longint($FF7FFFFF),
Longint($FEFFFFFF),Longint($FDFFFFFF),Longint($FBFFFFFF),Longint($F7FFFFFF),
Longint($EFFFFFFF),Longint($DFFFFFFF),Longint($BFFFFFFF),Longint($7FFFFFFF));
begin
// writeln('TestLongintClearBit Start');
for Index in TLongintBitIndex do
begin
L := Longint($FFFFFFFF);
L.ClearBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],L);
end;
// writeln('TestLongintClearBit: OK');
end;
Procedure TTestHelpers.TestLongintTestBit;
var
Index: TLongintBitIndex;
L: Longint;
const
Expected: array[TLongintBitIndex] of Boolean = (
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False);
begin
// writeln('TestLongintTestBit Start');
L := Longint($55555555);
for Index in TLongintBitIndex do
AssertEquals('Bit '+IntToStr(Index),Expected[Index],L.TestBit(Index));
// writeln('TestLongintTestBit: OK');
end;
Procedure TTestHelpers.TestNativeUintSetBit;
var
Index: TQWordBitIndex;
Q: NativeUInt;
const
Expected: array[TQWordBitIndex] of NativeUInt = (
$0000000000000001,$0000000000000003,$0000000000000007,$000000000000000F,
$000000000000001F,$000000000000003F,$000000000000007F,$00000000000000FF,
$00000000000001FF,$00000000000003FF,$00000000000007FF,$0000000000000FFF,
$0000000000001FFF,$0000000000003FFF,$0000000000007FFF,$000000000000FFFF,
$000000000001FFFF,$000000000003FFFF,$000000000007FFFF,$00000000000FFFFF,
$00000000001FFFFF,$00000000003FFFFF,$00000000007FFFFF,$0000000000FFFFFF,
$0000000001FFFFFF,$0000000003FFFFFF,$0000000007FFFFFF,$000000000FFFFFFF,
$000000001FFFFFFF,$000000003FFFFFFF,$000000007FFFFFFF,$00000000FFFFFFFF,
$00000001FFFFFFFF,$00000003FFFFFFFF,$00000007FFFFFFFF,$0000000FFFFFFFFF,
$0000001FFFFFFFFF,$0000003FFFFFFFFF,$0000007FFFFFFFFF,$000000FFFFFFFFFF,
$000001FFFFFFFFFF,$000003FFFFFFFFFF,$000007FFFFFFFFFF,$00000FFFFFFFFFFF,
$00001FFFFFFFFFFF,$00003FFFFFFFFFFF,$00007FFFFFFFFFFF,$0000FFFFFFFFFFFF,
$0001FFFFFFFFFFFF,$0003FFFFFFFFFFFF,$0007FFFFFFFFFFFF,$000FFFFFFFFFFFFF,
$001FFFFFFFFFFFFF{,$003FFFFFFFFFFFFF,$007FFFFFFFFFFFFF,$00FFFFFFFFFFFFFF,
$01FFFFFFFFFFFFFF,$03FFFFFFFFFFFFFF,$07FFFFFFFFFFFFFF,$0FFFFFFFFFFFFFFF,
$1FFFFFFFFFFFFFFF,$3FFFFFFFFFFFFFFF,$7FFFFFFFFFFFFFFF,QWORD($FFFFFFFFFFFFFFFF)});
begin
Fail('Not implemented');
// writeln('TestQWordSetBit Start');
Q := 0;
for Index in TQWordBitIndex do
begin
// TODO Q.SetBit(Index);
// AssertEquals('Bit '+IntToStr(Index),Expected[Index],S);
end;
// writeln('TestQWordSetBit: OK');
end;
Procedure TTestHelpers.TestNativeUIntToggleBit;
var
Index: TQWordBitIndex;
Q: NativeUint;
const
Expected: array[TQWordBitIndex] of NativeUInt = (
$0000000000000001,$0000000000000003,$0000000000000007,$000000000000000F,
$000000000000001F,$000000000000003F,$000000000000007F,$00000000000000FF,
$00000000000001FF,$00000000000003FF,$00000000000007FF,$0000000000000FFF,
$0000000000001FFF,$0000000000003FFF,$0000000000007FFF,$000000000000FFFF,
$000000000001FFFF,$000000000003FFFF,$000000000007FFFF,$00000000000FFFFF,
$00000000001FFFFF,$00000000003FFFFF,$00000000007FFFFF,$0000000000FFFFFF,
$0000000001FFFFFF,$0000000003FFFFFF,$0000000007FFFFFF,$000000000FFFFFFF,
$000000001FFFFFFF,$000000003FFFFFFF,$000000007FFFFFFF,$00000000FFFFFFFF,
$00000001FFFFFFFF,$00000003FFFFFFFF,$00000007FFFFFFFF,$0000000FFFFFFFFF,
$0000001FFFFFFFFF,$0000003FFFFFFFFF,$0000007FFFFFFFFF,$000000FFFFFFFFFF,
$000001FFFFFFFFFF,$000003FFFFFFFFFF,$000007FFFFFFFFFF,$00000FFFFFFFFFFF,
$00001FFFFFFFFFFF,$00003FFFFFFFFFFF,$00007FFFFFFFFFFF,$0000FFFFFFFFFFFF,
$0001FFFFFFFFFFFF,$0003FFFFFFFFFFFF,$0007FFFFFFFFFFFF,$000FFFFFFFFFFFFF,
$001FFFFFFFFFFFFF{,$003FFFFFFFFFFFFF,$007FFFFFFFFFFFFF,$00FFFFFFFFFFFFFF,
$01FFFFFFFFFFFFFF,$03FFFFFFFFFFFFFF,$07FFFFFFFFFFFFFF,$0FFFFFFFFFFFFFFF,
$1FFFFFFFFFFFFFFF,$3FFFFFFFFFFFFFFF,$7FFFFFFFFFFFFFFF,QWORD($FFFFFFFFFFFFFFFF)});
begin
Fail('Not implemented');
// writeln('TestQWordToggleBit Start');
Q := 0;
for Index in TQWordBitIndex do
begin
// TODO Q.ToggleBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],Q);
end;
// writeln('TestQWordToggleBit: OK');
end;
Procedure TTestHelpers.TestNativeUIntTestBit;
var
Index: TQWordBitIndex;
Q: NativeUint;
const
Expected: array[TQWordBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True);
begin
Fail('NotImplemented');
// writeln('TestQWordTestBit Start');
Q := $5555555555;
for Index in TQWordBitIndex do
// AssertEquals('Bit '+IntToStr(Index),Expected[Index],Q.TestBit(Index));
// writeln('TestQWordTestBit: OK');
end;
Procedure TTestHelpers.TestNativeIntSetBit;
var
Index: TInt64BitIndex;
I64: NativeInt;
const
Expected: array[TNativeIntBitIndex] of NativeInt = (
NativeInt($0000000000000001),NativeInt($0000000000000003),NativeInt($0000000000000007),NativeInt($000000000000000F),
NativeInt($000000000000001F),NativeInt($000000000000003F),NativeInt($000000000000007F),NativeInt($00000000000000FF),
NativeInt($00000000000001FF),NativeInt($00000000000003FF),NativeInt($00000000000007FF),NativeInt($0000000000000FFF),
NativeInt($0000000000001FFF),NativeInt($0000000000003FFF),NativeInt($0000000000007FFF),NativeInt($000000000000FFFF),
NativeInt($000000000001FFFF),NativeInt($000000000003FFFF),NativeInt($000000000007FFFF),NativeInt($00000000000FFFFF),
NativeInt($00000000001FFFFF),NativeInt($00000000003FFFFF),NativeInt($00000000007FFFFF),NativeInt($0000000000FFFFFF),
NativeInt($0000000001FFFFFF),NativeInt($0000000003FFFFFF),NativeInt($0000000007FFFFFF),NativeInt($000000000FFFFFFF),
NativeInt($000000001FFFFFFF),NativeInt($000000003FFFFFFF),NativeInt($000000007FFFFFFF),NativeInt($00000000FFFFFFFF),
NativeInt($00000001FFFFFFFF),NativeInt($00000003FFFFFFFF),NativeInt($00000007FFFFFFFF),NativeInt($0000000FFFFFFFFF),
NativeInt($0000001FFFFFFFFF),NativeInt($0000003FFFFFFFFF),NativeInt($0000007FFFFFFFFF),NativeInt($000000FFFFFFFFFF),
NativeInt($000001FFFFFFFFFF),NativeInt($000003FFFFFFFFFF),NativeInt($000007FFFFFFFFFF),NativeInt($00000FFFFFFFFFFF),
NativeInt($00001FFFFFFFFFFF),NativeInt($00003FFFFFFFFFFF),NativeInt($00007FFFFFFFFFFF),NativeInt($0000FFFFFFFFFFFF),
NativeInt($0001FFFFFFFFFFFF),NativeInt($0003FFFFFFFFFFFF),NativeInt($0007FFFFFFFFFFFF),NativeInt($000FFFFFFFFFFFFF),
NativeInt($001FFFFFFFFFFFFF));
begin
Fail('Not implemented');
// writeln('TestNativeIntSetBit Start');
I64 := 0;
for Index in TNativeIntBitIndex do
begin
// TODO I64.SetBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],I64);
end;
// writeln('TestNativeIntSetBit: OK');
end;
Procedure TTestHelpers.TestNativeIntToggleBit;
var
Index: TNativeIntBitIndex;
I64: NativeInt;
const
Expected: array[TNativeIntBitIndex] of NativeInt = (
NativeInt($0000000000000001),NativeInt($0000000000000003),NativeInt($0000000000000007),NativeInt($000000000000000F),
NativeInt($000000000000001F),NativeInt($000000000000003F),NativeInt($000000000000007F),NativeInt($00000000000000FF),
NativeInt($00000000000001FF),NativeInt($00000000000003FF),NativeInt($00000000000007FF),NativeInt($0000000000000FFF),
NativeInt($0000000000001FFF),NativeInt($0000000000003FFF),NativeInt($0000000000007FFF),NativeInt($000000000000FFFF),
NativeInt($000000000001FFFF),NativeInt($000000000003FFFF),NativeInt($000000000007FFFF),NativeInt($00000000000FFFFF),
NativeInt($00000000001FFFFF),NativeInt($00000000003FFFFF),NativeInt($00000000007FFFFF),NativeInt($0000000000FFFFFF),
NativeInt($0000000001FFFFFF),NativeInt($0000000003FFFFFF),NativeInt($0000000007FFFFFF),NativeInt($000000000FFFFFFF),
NativeInt($000000001FFFFFFF),NativeInt($000000003FFFFFFF),NativeInt($000000007FFFFFFF),NativeInt($00000000FFFFFFFF),
NativeInt($00000001FFFFFFFF),NativeInt($00000003FFFFFFFF),NativeInt($00000007FFFFFFFF),NativeInt($0000000FFFFFFFFF),
NativeInt($0000001FFFFFFFFF),NativeInt($0000003FFFFFFFFF),NativeInt($0000007FFFFFFFFF),NativeInt($000000FFFFFFFFFF),
NativeInt($000001FFFFFFFFFF),NativeInt($000003FFFFFFFFFF),NativeInt($000007FFFFFFFFFF),NativeInt($00000FFFFFFFFFFF),
NativeInt($00001FFFFFFFFFFF),NativeInt($00003FFFFFFFFFFF),NativeInt($00007FFFFFFFFFFF),NativeInt($0000FFFFFFFFFFFF),
NativeInt($0001FFFFFFFFFFFF),NativeInt($0003FFFFFFFFFFFF),NativeInt($0007FFFFFFFFFFFF),NativeInt($000FFFFFFFFFFFFF),
NativeInt($001FFFFFFFFFFFFF));
begin
Fail('Not implemented');
// writeln('TestNativeIntToggleBit Start');
I64 := 0;
for Index in TNativeIntBitIndex do
begin
//I64.ToggleBit(Index);
AssertEquals('Bit '+IntToStr(Index),Expected[Index],I64);
end;
// writeln('TestNativeIntToggleBit: OK');
end;
Procedure TTestHelpers.TestNativeIntClearBit;
var
Index: TNativeIntBitIndex;
I64: NativeInt;
begin
Fail('NotImplemented');
// for Index in TNativeIntBitIndex do
begin
// I64 := NativeInt($FFFFFFFFFFFFFFFF);
// I64.ClearBit(Index);
// AssertEquals('Bit '+IntToStr(Index),Expected[Index],I64);
end;
// writeln('TestNativeIntClearBit: OK');
end;
Procedure TTestHelpers.TestNativeIntTestBit;
var
Index: TNativeIntBitIndex;
I64: NativeInt;
const
Expected: array[TNativeIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True,False,True,False,
True,False,True,False,True);
begin
// writeln('TestNativeIntTestBit Start');
I64 := NativeInt($5555555555555);
for Index in TNativeIntBitIndex do
// AssertEquals('Bit '+IntToStr(Index),Expected[Index],I64.TestBit(Index));
// writeln('TestNativeIntTestBit: OK');
end;
initialization
RegisterTest(TTestHelpers);
end.