mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 04:09:33 +02:00
Merged revision(s) 45409, 46897-46898, 47007, 47011, 47065, 47084 from trunk:
* fix for Mantis #37042: apply patch and test (adjusted for Big Endian) by Bi0T1N to add support for TBitConverter ........ * avoid range check error when using SwapEndian with 16-bit constants + added test ........ * readd SmallInt typecasts to SmallInt overload of SwapEndian ........ * when removing a method from the synchronization queue using TThread.RemoveQueuedEvent then both the Code and the Data need to match (Delphi does the same) + added test ........ * simplify TThread.RemoveQueuedEvent - decide what to delete and not what to leave (better corresponds with the docs) ........ + add ability to specify a SQLite VFS when opening a SQLite database ........ * fix test: TThread.WaitFor calls CheckSynchronize as well, so the thread needs to signal when it's done with removing entries from the queue ........ git-svn-id: branches/fixes_3_2@47782 -
This commit is contained in:
parent
8a249b2d74
commit
432fcd52bc
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -12931,6 +12931,8 @@ tests/tbs/tb0665.pp svneol=native#text/pascal
|
||||
tests/tbs/tb0666a.pp svneol=native#text/pascal
|
||||
tests/tbs/tb0666b.pp svneol=native#text/pascal
|
||||
tests/tbs/tb0669.pp svneol=native#text/pascal
|
||||
tests/tbs/tb0676.pp svneol=native#text/pascal
|
||||
tests/tbs/tb0678.pp svneol=native#text/pascal
|
||||
tests/tbs/tb205.pp svneol=native#text/plain
|
||||
tests/tbs/tb610.pp svneol=native#text/pascal
|
||||
tests/tbs/tb613.pp svneol=native#text/plain
|
||||
@ -15567,6 +15569,7 @@ tests/test/units/sysutils/tunifile.pp svneol=native#text/plain
|
||||
tests/test/units/sysutils/tuplow.pp svneol=native#text/plain
|
||||
tests/test/units/sysutils/twstralloc.pp svneol=native#text/plain
|
||||
tests/test/units/sysutils/twstrcmp.pp svneol=native#text/plain
|
||||
tests/test/units/types/ttbitconverter.pp svneol=native#text/pascal
|
||||
tests/test/units/ucomplex/tcsqr1.pp svneol=native#text/pascal
|
||||
tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
|
||||
tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
|
||||
|
@ -44,7 +44,6 @@ type
|
||||
TArrayStringArray = Array of TStringArray;
|
||||
PArrayStringArray = ^TArrayStringArray;
|
||||
|
||||
// VFS not supported at this time.
|
||||
// Do not change the order. See NativeFlags constant in GetSQLiteOpenFlags.
|
||||
|
||||
TSQLiteOpenFlag = (
|
||||
@ -69,8 +68,10 @@ Type
|
||||
private
|
||||
fhandle: psqlite3;
|
||||
FOpenFlags: TSQLiteOpenFlags;
|
||||
FVFS: String;
|
||||
function GetSQLiteOpenFlags: Integer;
|
||||
procedure SetOpenFlags(AValue: TSQLiteOpenFlags);
|
||||
procedure SetVFS(const AValue: String);
|
||||
protected
|
||||
procedure DoInternalConnect; override;
|
||||
procedure DoInternalDisconnect; override;
|
||||
@ -125,6 +126,7 @@ Type
|
||||
procedure LoadExtension(const LibraryFile: string);
|
||||
Published
|
||||
Property OpenFlags : TSQLiteOpenFlags Read FOpenFlags Write SetOpenFlags default DefaultOpenFlags;
|
||||
Property VFS : String Read FVFS Write SetVFS;
|
||||
Property AlwaysUseBigint : Boolean Read GetAlwaysUseBigint Write SetAlwaysUseBigint;
|
||||
end;
|
||||
|
||||
@ -857,16 +859,28 @@ begin
|
||||
FOpenFlags:=AValue;
|
||||
end;
|
||||
|
||||
procedure TSQLite3Connection.SetVFS(const AValue: String);
|
||||
begin
|
||||
if FVFS=AValue then Exit;
|
||||
CheckDisConnected;
|
||||
FVFS:=AValue;
|
||||
end;
|
||||
|
||||
procedure TSQLite3Connection.DoInternalConnect;
|
||||
var
|
||||
filename: ansistring;
|
||||
pvfs: PChar;
|
||||
begin
|
||||
Inherited;
|
||||
if DatabaseName = '' then
|
||||
DatabaseError(SErrNoDatabaseName,self);
|
||||
InitializeSQLite;
|
||||
filename := DatabaseName;
|
||||
checkerror(sqlite3_open_v2(PAnsiChar(filename),@fhandle,GetSQLiteOpenFlags,Nil));
|
||||
if FVFS <> '' then
|
||||
pvfs := PAnsiChar(FVFS)
|
||||
else
|
||||
pvfs := Nil;
|
||||
checkerror(sqlite3_open_v2(PAnsiChar(filename),@fhandle,GetSQLiteOpenFlags,pvfs));
|
||||
if (Length(Password)>0) and assigned(sqlite3_key) then
|
||||
checkerror(sqlite3_key(fhandle,PChar(Password),StrLen(PChar(Password))));
|
||||
if Params.IndexOfName('foreign_keys') <> -1 then
|
||||
|
@ -1134,13 +1134,13 @@ function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inlin
|
||||
{ is turned into "longint(AValue) shr 8", so if AValue < 0 then }
|
||||
{ the sign bits from the upper 16 bits are shifted in rather than }
|
||||
{ zeroes. }
|
||||
Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
|
||||
Result := SmallInt(((Word(AValue) shr 8) or (Word(AValue) shl 8)) and $ffff);
|
||||
end;
|
||||
|
||||
|
||||
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
Result := Word((AValue shr 8) or (AValue shl 8));
|
||||
Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
|
||||
end;
|
||||
|
||||
(*
|
||||
|
@ -2643,13 +2643,13 @@ function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inlin
|
||||
{ is turned into "longint(AValue) shr 8", so if AValue < 0 then }
|
||||
{ the sign bits from the upper 16 bits are shifted in rather than }
|
||||
{ zeroes. }
|
||||
Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
|
||||
Result := SmallInt(((Word(AValue) shr 8) or (Word(AValue) shl 8)) and $ffff);
|
||||
end;
|
||||
|
||||
{$ifndef cpujvm}
|
||||
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
Result := Word((AValue shr 8) or (AValue shl 8));
|
||||
Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
|
@ -596,38 +596,35 @@ begin
|
||||
lastentry := Nil;
|
||||
entry := ThreadQueueHead;
|
||||
while Assigned(entry) do begin
|
||||
{ first check for the thread }
|
||||
if Assigned(aThread) and (entry^.Thread <> aThread) and (entry^.ThreadID <> aThread.ThreadID) then begin
|
||||
if
|
||||
{ only entries not added by Synchronize }
|
||||
not Assigned(entry^.SyncEvent)
|
||||
{ check for the thread }
|
||||
and (not Assigned(aThread) or (entry^.Thread = aThread) or (entry^.ThreadID = aThread.ThreadID))
|
||||
{ check for the method }
|
||||
and (not Assigned(aMethod) or
|
||||
(
|
||||
(TMethod(entry^.Method).Code = TMethod(aMethod).Code) and
|
||||
(TMethod(entry^.Method).Data = TMethod(aMethod).Data)
|
||||
))
|
||||
then begin
|
||||
{ ok, we need to remove this entry }
|
||||
tmpentry := entry;
|
||||
if Assigned(lastentry) then
|
||||
lastentry^.Next := entry^.Next;
|
||||
entry := entry^.Next;
|
||||
if ThreadQueueHead = tmpentry then
|
||||
ThreadQueueHead := entry;
|
||||
if ThreadQueueTail = tmpentry then
|
||||
ThreadQueueTail := lastentry;
|
||||
{ only dispose events added by Queue }
|
||||
if not Assigned(tmpentry^.SyncEvent) then
|
||||
Dispose(tmpentry);
|
||||
end else begin
|
||||
{ leave this entry }
|
||||
lastentry := entry;
|
||||
entry := entry^.Next;
|
||||
Continue;
|
||||
end;
|
||||
{ then check for the method }
|
||||
if Assigned(aMethod) and (entry^.Method <> aMethod) then begin
|
||||
lastentry := entry;
|
||||
entry := entry^.Next;
|
||||
Continue;
|
||||
end;
|
||||
{ skip entries added by Synchronize }
|
||||
if Assigned(entry^.SyncEvent) then begin
|
||||
lastentry := entry;
|
||||
entry := entry^.Next;
|
||||
Continue;
|
||||
end;
|
||||
|
||||
{ ok, we need to remove this entry }
|
||||
|
||||
tmpentry := entry;
|
||||
if Assigned(lastentry) then
|
||||
lastentry^.Next := entry^.Next;
|
||||
entry := entry^.Next;
|
||||
if ThreadQueueHead = tmpentry then
|
||||
ThreadQueueHead := entry;
|
||||
if ThreadQueueTail = tmpentry then
|
||||
ThreadQueueTail := lastentry;
|
||||
{ only dispose events added by Queue }
|
||||
if not Assigned(tmpentry^.SyncEvent) then
|
||||
Dispose(tmpentry);
|
||||
end;
|
||||
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||
finally
|
||||
|
@ -341,6 +341,16 @@ function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
|
||||
function Size(AWidth, AHeight: Integer): TSize; inline;
|
||||
function Size(const ARect: TRect): TSize;
|
||||
|
||||
{$ifndef VER3_0}
|
||||
type
|
||||
TBitConverter = class
|
||||
generic class procedure UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static; {inline;}
|
||||
generic class procedure From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0); static;
|
||||
generic class function UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static; {inline;}
|
||||
generic class function InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T; static;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
implementation
|
||||
|
||||
Uses Math;
|
||||
@ -712,4 +722,44 @@ begin
|
||||
bottom:=bottom+dy; top:=top+dy;
|
||||
end;
|
||||
|
||||
{$ifndef VER3_0}
|
||||
generic class procedure TBitConverter.UnsafeFrom<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
|
||||
begin
|
||||
move(ASrcValue, ADestination[AOffset], SizeOf(T));
|
||||
end;
|
||||
|
||||
generic class procedure TBitConverter.From<T>(const ASrcValue: T; var ADestination: Array of Byte; AOffset: Integer = 0);
|
||||
begin
|
||||
if AOffset < 0 then
|
||||
System.Error(reRangeError);
|
||||
|
||||
if IsManagedType(T) then
|
||||
System.Error(reInvalidCast);
|
||||
|
||||
if Length(ADestination) < (SizeOf(T) + AOffset) then
|
||||
System.Error(reRangeError);
|
||||
|
||||
TBitConverter.specialize UnsafeFrom<T>(ASrcValue, ADestination, AOffset);
|
||||
end;
|
||||
|
||||
generic class function TBitConverter.UnsafeInTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
|
||||
begin
|
||||
move(ASource[AOffset], Result, SizeOf(T));
|
||||
end;
|
||||
|
||||
generic class function TBitConverter.InTo<T>(const ASource: Array of Byte; AOffset: Integer = 0): T;
|
||||
begin
|
||||
if AOffset < 0 then
|
||||
System.Error(reRangeError);
|
||||
|
||||
if IsManagedType(T) then
|
||||
System.Error(reInvalidCast);
|
||||
|
||||
if Length(ASource) < (SizeOf(T) + AOffset) then
|
||||
System.Error(reRangeError);
|
||||
|
||||
Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
@ -1014,13 +1014,13 @@ function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inlin
|
||||
{ is turned into "longint(AValue) shr 8", so if AValue < 0 then }
|
||||
{ the sign bits from the upper 16 bits are shifted in rather than }
|
||||
{ zeroes. }
|
||||
Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
|
||||
Result := SmallInt(((Word(AValue) shr 8) or (Word(AValue) shl 8)) and $ffff);
|
||||
end;
|
||||
|
||||
|
||||
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
Result := Word((AValue shr 8) or (AValue shl 8));
|
||||
Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
|
||||
end;
|
||||
|
||||
|
||||
|
14
tests/tbs/tb0676.pp
Normal file
14
tests/tbs/tb0676.pp
Normal file
@ -0,0 +1,14 @@
|
||||
{ %NORUN }
|
||||
|
||||
program tb0676;
|
||||
|
||||
{$warn 4110 error}
|
||||
|
||||
begin
|
||||
SwapEndian(UInt16($1234));
|
||||
SwapEndian(Int16($8765));
|
||||
SwapEndian(UInt32($12345678));
|
||||
SwapEndian(Int32($87654321));
|
||||
SwapEndian(UInt64($1234567887654321));
|
||||
SwapEndian(Int64($8765432112345678));
|
||||
end.
|
80
tests/tbs/tb0678.pp
Normal file
80
tests/tbs/tb0678.pp
Normal file
@ -0,0 +1,80 @@
|
||||
{%skiptarget=$nothread }
|
||||
|
||||
program tqueue;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
{$ifdef unix}
|
||||
cthreads,
|
||||
{$endif}
|
||||
SysUtils, Classes;
|
||||
|
||||
type
|
||||
TTest = class
|
||||
procedure DoTest;
|
||||
end;
|
||||
|
||||
TTestThread = class(TThread)
|
||||
protected
|
||||
procedure Execute; override;
|
||||
end;
|
||||
|
||||
var
|
||||
count: LongInt = 0;
|
||||
|
||||
procedure TTest.DoTest;
|
||||
begin
|
||||
Inc(count);
|
||||
end;
|
||||
|
||||
var
|
||||
e: PRTLEvent;
|
||||
t1, t2: TTest;
|
||||
|
||||
procedure TTestThread.Execute;
|
||||
var
|
||||
method: TMethod;
|
||||
begin
|
||||
Queue(@t1.DoTest);
|
||||
Queue(@t2.DoTest);
|
||||
|
||||
{ should remove nothing }
|
||||
method.Code := @TTest.DoTest;
|
||||
method.Data := Nil;
|
||||
|
||||
RemoveQueuedEvents(TThreadMethod(method));
|
||||
|
||||
{ should remove only one }
|
||||
RemoveQueuedEvents(@t1.DoTest);
|
||||
|
||||
RTLEventSetEvent(e);
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTestThread;
|
||||
begin
|
||||
e := Nil;
|
||||
t := TTestThread.Create(True);
|
||||
try
|
||||
e := RTLEventCreate;
|
||||
|
||||
t1 := TTest.Create;
|
||||
t2 := TTest.Create;
|
||||
|
||||
t.Start;
|
||||
RTLEventWaitFor(e);
|
||||
t.WaitFor;
|
||||
|
||||
CheckSynchronize;
|
||||
|
||||
if count <> 1 then
|
||||
Halt(1);
|
||||
finally
|
||||
t1.Free;
|
||||
t2.Free;
|
||||
t.Free;
|
||||
RTLEventDestroy(e);
|
||||
end;
|
||||
end.
|
||||
|
389
tests/test/units/types/ttbitconverter.pp
Normal file
389
tests/test/units/types/ttbitconverter.pp
Normal file
@ -0,0 +1,389 @@
|
||||
program ttbitconverter;
|
||||
|
||||
{$mode Delphi}
|
||||
|
||||
uses
|
||||
SysUtils, Types;
|
||||
|
||||
type
|
||||
TMyRecord = record
|
||||
Number: Integer;
|
||||
SmallNumber: Word;
|
||||
UseIt: Boolean;
|
||||
end;
|
||||
|
||||
TMyPackedRecord = packed record
|
||||
Number: Integer;
|
||||
SmallNumber: Word;
|
||||
UseIt: Boolean;
|
||||
end;
|
||||
|
||||
procedure TestFromInteger;
|
||||
var
|
||||
arr: TBytes;
|
||||
item: Byte;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
SetLength(arr, SizeOf(Integer));
|
||||
TBitConverter.From<Integer>(NtoLE(Integer(1038)), arr);
|
||||
for item in arr do
|
||||
begin
|
||||
Inc(i);
|
||||
writeln(i.ToString + ': ' + item.ToString);
|
||||
end;
|
||||
|
||||
if arr[0] <> 14 then halt(1);
|
||||
if arr[1] <> 4 then halt(1);
|
||||
if arr[2] <> 0 then halt(1);
|
||||
if arr[3] <> 0 then halt(1);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestFromDouble;
|
||||
var
|
||||
arr: TBytes;
|
||||
item: Byte;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
SetLength(arr, SizeOf(Double));
|
||||
TBitConverter.From<Double>(Double(3.14), arr);
|
||||
for item in arr do
|
||||
begin
|
||||
Inc(i);
|
||||
writeln(i.ToString + ': ' + item.ToString);
|
||||
end;
|
||||
|
||||
if PDouble(@arr[0])^ <> Double(3.14) then halt(2);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestFromTMyRecord;
|
||||
var
|
||||
arr: TBytes;
|
||||
item: Byte;
|
||||
rec: TMyRecord;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
SetLength(arr, SizeOf(TMyRecord));
|
||||
|
||||
rec := Default(TMyRecord);
|
||||
rec.Number := NToLE(LongInt(42));
|
||||
rec.SmallNumber := NToLE(Word(5));
|
||||
rec.UseIt := True;
|
||||
TBitConverter.From<TMyRecord>(rec, arr);
|
||||
|
||||
for item in arr do
|
||||
begin
|
||||
Inc(i);
|
||||
writeln(i.ToString + ': ' + item.ToString);
|
||||
end;
|
||||
|
||||
if arr[0] <> 42 then halt(3);
|
||||
if arr[1] <> 0 then halt(3);
|
||||
if arr[2] <> 0 then halt(3);
|
||||
if arr[3] <> 0 then halt(3);
|
||||
if arr[4] <> 5 then halt(3);
|
||||
if arr[5] <> 0 then halt(3);
|
||||
if arr[6] <> 1 then halt(3);
|
||||
if arr[7] <> 0 then halt(3);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestFromTMyPackedRecord;
|
||||
var
|
||||
arr: TBytes;
|
||||
item: Byte;
|
||||
rec: TMyPackedRecord;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
SetLength(arr, SizeOf(TMyPackedRecord));
|
||||
|
||||
rec := Default(TMyPackedRecord);
|
||||
rec.Number := NToLe(Integer(42));
|
||||
rec.SmallNumber := NToLe(Word(289));
|
||||
rec.UseIt := True;
|
||||
TBitConverter.From<TMyPackedRecord>(rec, arr);
|
||||
|
||||
for item in arr do
|
||||
begin
|
||||
Inc(i);
|
||||
writeln(i.ToString + ': ' + item.ToString);
|
||||
end;
|
||||
|
||||
if arr[0] <> 42 then halt(4);
|
||||
if arr[1] <> 0 then halt(4);
|
||||
if arr[2] <> 0 then halt(4);
|
||||
if arr[3] <> 0 then halt(4);
|
||||
if arr[4] <> 33 then halt(4);
|
||||
if arr[5] <> 1 then halt(4);
|
||||
if arr[6] <> 1 then halt(4);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestFromAnsiChar;
|
||||
var
|
||||
arr: TBytes;
|
||||
item: Byte;
|
||||
c: AnsiChar;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
c := 'A';
|
||||
SetLength(arr, SizeOf(c));
|
||||
TBitConverter.From<AnsiChar>(c, arr);
|
||||
|
||||
for item in arr do
|
||||
begin
|
||||
Inc(i);
|
||||
writeln(i.ToString + ': ' + item.ToString);
|
||||
end;
|
||||
|
||||
if arr[0] <> 65 then halt(5);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestFromUnicodeChar;
|
||||
var
|
||||
arr: TBytes;
|
||||
item: Byte;
|
||||
c: UnicodeChar;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
c := 'A';
|
||||
SetLength(arr, SizeOf(c));
|
||||
TBitConverter.From<UnicodeChar>(UnicodeChar(NToLE(Ord(c))), arr);
|
||||
|
||||
for item in arr do
|
||||
begin
|
||||
Inc(i);
|
||||
writeln(i.ToString + ': ' + item.ToString);
|
||||
end;
|
||||
|
||||
if arr[0] <> 65 then halt(6);
|
||||
if arr[1] <> 0 then halt(6);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestInToInteger;
|
||||
var
|
||||
arr: TBytes;
|
||||
num: Integer;
|
||||
begin
|
||||
arr := TArray<Byte>.Create(1, 0, 1, 0);
|
||||
|
||||
num := TBitConverter.InTo<Integer>(arr, 0);
|
||||
num := LEToN(num);
|
||||
writeln(num.ToString);
|
||||
|
||||
if num <> 65537 then halt(7);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestInToDouble;
|
||||
var
|
||||
arr: TBytes;
|
||||
num: Double;
|
||||
tmp: Int64;
|
||||
begin
|
||||
arr := TArray<Byte>.Create($1C, $C7, $71, $1C, $C7, $71, $BC, $3F);
|
||||
|
||||
num := TBitConverter.InTo<Double>(arr, 0);
|
||||
tmp := LEToN(PInt64(@num)^);
|
||||
num := PDouble(@tmp)^;
|
||||
writeln(num.ToString);
|
||||
|
||||
if num <> Double(0.1111111111111111111) then halt(8);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestInToTMyRecord;
|
||||
var
|
||||
arr: TBytes;
|
||||
rec: TMyRecord;
|
||||
begin
|
||||
arr := TArray<Byte>.Create(66, 0, 0, 0, 15, 0, 0, 0);
|
||||
|
||||
rec := TBitConverter.InTo<TMyRecord>(arr, 0);
|
||||
rec.Number := LEToN(rec.Number);
|
||||
rec.SmallNumber := LEToN(rec.SmallNumber);
|
||||
writeln(rec.Number.ToString);
|
||||
writeln(rec.SmallNumber.ToString);
|
||||
writeln(BoolToStr(rec.UseIt, True));
|
||||
|
||||
if rec.Number <> 66 then halt(9);
|
||||
if rec.SmallNumber <> 15 then halt(9);
|
||||
if rec.UseIt <> False then halt(9);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestInToTMyPackedRecord;
|
||||
var
|
||||
arr: TBytes;
|
||||
rec: TMyPackedRecord;
|
||||
begin
|
||||
arr := TArray<Byte>.Create(255, 1, 0, 0, 15, 0, 1);
|
||||
|
||||
rec := TBitConverter.InTo<TMyPackedRecord>(arr, 0);
|
||||
rec.Number := LEToN(rec.Number);
|
||||
rec.SmallNumber := LEToN(rec.SmallNumber);
|
||||
writeln(rec.Number.ToString);
|
||||
writeln(rec.SmallNumber.ToString);
|
||||
writeln(BoolToStr(rec.UseIt, True));
|
||||
|
||||
if rec.Number <> 511 then halt(10);
|
||||
if rec.SmallNumber <> 15 then halt(10);
|
||||
if rec.UseIt <> True then halt(10);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestInToAnsiChar;
|
||||
var
|
||||
arr: TBytes;
|
||||
c: AnsiChar;
|
||||
begin
|
||||
arr := TArray<Byte>.Create(65);
|
||||
|
||||
c := TBitConverter.InTo<AnsiChar>(arr, 0);
|
||||
writeln(c);
|
||||
|
||||
if c <> 'A' then halt(11);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestInToUnicodeChar;
|
||||
var
|
||||
arr: TBytes;
|
||||
c: UnicodeChar;
|
||||
begin
|
||||
arr := TArray<Byte>.Create(66, 0);
|
||||
|
||||
c := TBitConverter.InTo<UnicodeChar>(arr, 0);
|
||||
c := UnicodeChar(LEToN(Ord(c)));
|
||||
writeln(c);
|
||||
|
||||
if c <> 'B' then halt(12);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestFromIntegerOffset;
|
||||
var
|
||||
arr: TBytes;
|
||||
item: Byte;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
SetLength(arr, SizeOf(Integer) + 2);
|
||||
TBitConverter.From<Integer>(NToLE(Integer(257)), arr, 2);
|
||||
for item in arr do
|
||||
begin
|
||||
Inc(i);
|
||||
writeln(i.ToString + ': ' + item.ToString);
|
||||
end;
|
||||
|
||||
if arr[0] <> 0 then halt(13);
|
||||
if arr[1] <> 0 then halt(13);
|
||||
if arr[2] <> 1 then halt(13);
|
||||
if arr[3] <> 1 then halt(13);
|
||||
if arr[4] <> 0 then halt(13);
|
||||
if arr[5] <> 0 then halt(13);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestInToIntegerOffset;
|
||||
var
|
||||
arr: TBytes;
|
||||
num: Integer;
|
||||
begin
|
||||
arr := TArray<Byte>.Create(2, 0, 2, 0, 1, 0, 2, 0);
|
||||
|
||||
num := TBitConverter.InTo<Integer>(arr, 2);
|
||||
num := LEToN(num);
|
||||
writeln(num.ToString);
|
||||
|
||||
if num <> 65538 then halt(14);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
{
|
||||
procedure TestInToAnsiString;
|
||||
var
|
||||
arr: TBytes;
|
||||
str: AnsiString;
|
||||
begin
|
||||
arr := TArray<Byte>.Create(44, 44, 45, 67, 66);
|
||||
|
||||
str := TBitConverter.InTo<AnsiString>(arr, 0);
|
||||
writeln(str);
|
||||
|
||||
if str <> 'hello' then halt(15);
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
procedure TestFromAnsiString;
|
||||
var
|
||||
arr: TBytes;
|
||||
item: Byte;
|
||||
str: AnsiString;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
str := 'hello world!';
|
||||
SetLength(arr, Length(str));
|
||||
TBitConverter.From<AnsiString>(str, arr);
|
||||
|
||||
for item in arr do
|
||||
begin
|
||||
Inc(i);
|
||||
writeln(i.ToString + ': ' + item.ToString);
|
||||
end;
|
||||
|
||||
writeln('');
|
||||
end;
|
||||
}
|
||||
begin
|
||||
{* testing TBitConverter.From<T> *}
|
||||
TestFromInteger;
|
||||
TestFromDouble;
|
||||
TestFromTMyRecord;
|
||||
TestFromTMyPackedRecord;
|
||||
TestFromAnsiChar;
|
||||
TestFromUnicodeChar;
|
||||
|
||||
{* testing TBitConverter.InTo<T> *}
|
||||
TestInToInteger;
|
||||
TestInToDouble;
|
||||
TestInToTMyRecord;
|
||||
TestInToTMyPackedRecord;
|
||||
TestInToAnsiChar;
|
||||
TestInToUnicodeChar;
|
||||
|
||||
{* testing offset *}
|
||||
TestFromIntegerOffset;
|
||||
TestInToIntegerOffset;
|
||||
|
||||
{* non base types *}
|
||||
//TestInToAnsiString;
|
||||
//TestFromAnsiString;
|
||||
|
||||
writeln('ok');
|
||||
//readln;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user