mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 17:09:16 +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/tb0666a.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb0666b.pp svneol=native#text/pascal
|
tests/tbs/tb0666b.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb0669.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/tb205.pp svneol=native#text/plain
|
||||||
tests/tbs/tb610.pp svneol=native#text/pascal
|
tests/tbs/tb610.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb613.pp svneol=native#text/plain
|
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/tuplow.pp svneol=native#text/plain
|
||||||
tests/test/units/sysutils/twstralloc.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/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/ucomplex/tcsqr1.pp svneol=native#text/pascal
|
||||||
tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
|
tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
|
||||||
tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
|
tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
|
||||||
|
@ -44,7 +44,6 @@ type
|
|||||||
TArrayStringArray = Array of TStringArray;
|
TArrayStringArray = Array of TStringArray;
|
||||||
PArrayStringArray = ^TArrayStringArray;
|
PArrayStringArray = ^TArrayStringArray;
|
||||||
|
|
||||||
// VFS not supported at this time.
|
|
||||||
// Do not change the order. See NativeFlags constant in GetSQLiteOpenFlags.
|
// Do not change the order. See NativeFlags constant in GetSQLiteOpenFlags.
|
||||||
|
|
||||||
TSQLiteOpenFlag = (
|
TSQLiteOpenFlag = (
|
||||||
@ -69,8 +68,10 @@ Type
|
|||||||
private
|
private
|
||||||
fhandle: psqlite3;
|
fhandle: psqlite3;
|
||||||
FOpenFlags: TSQLiteOpenFlags;
|
FOpenFlags: TSQLiteOpenFlags;
|
||||||
|
FVFS: String;
|
||||||
function GetSQLiteOpenFlags: Integer;
|
function GetSQLiteOpenFlags: Integer;
|
||||||
procedure SetOpenFlags(AValue: TSQLiteOpenFlags);
|
procedure SetOpenFlags(AValue: TSQLiteOpenFlags);
|
||||||
|
procedure SetVFS(const AValue: String);
|
||||||
protected
|
protected
|
||||||
procedure DoInternalConnect; override;
|
procedure DoInternalConnect; override;
|
||||||
procedure DoInternalDisconnect; override;
|
procedure DoInternalDisconnect; override;
|
||||||
@ -125,6 +126,7 @@ Type
|
|||||||
procedure LoadExtension(const LibraryFile: string);
|
procedure LoadExtension(const LibraryFile: string);
|
||||||
Published
|
Published
|
||||||
Property OpenFlags : TSQLiteOpenFlags Read FOpenFlags Write SetOpenFlags default DefaultOpenFlags;
|
Property OpenFlags : TSQLiteOpenFlags Read FOpenFlags Write SetOpenFlags default DefaultOpenFlags;
|
||||||
|
Property VFS : String Read FVFS Write SetVFS;
|
||||||
Property AlwaysUseBigint : Boolean Read GetAlwaysUseBigint Write SetAlwaysUseBigint;
|
Property AlwaysUseBigint : Boolean Read GetAlwaysUseBigint Write SetAlwaysUseBigint;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -857,16 +859,28 @@ begin
|
|||||||
FOpenFlags:=AValue;
|
FOpenFlags:=AValue;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TSQLite3Connection.SetVFS(const AValue: String);
|
||||||
|
begin
|
||||||
|
if FVFS=AValue then Exit;
|
||||||
|
CheckDisConnected;
|
||||||
|
FVFS:=AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSQLite3Connection.DoInternalConnect;
|
procedure TSQLite3Connection.DoInternalConnect;
|
||||||
var
|
var
|
||||||
filename: ansistring;
|
filename: ansistring;
|
||||||
|
pvfs: PChar;
|
||||||
begin
|
begin
|
||||||
Inherited;
|
Inherited;
|
||||||
if DatabaseName = '' then
|
if DatabaseName = '' then
|
||||||
DatabaseError(SErrNoDatabaseName,self);
|
DatabaseError(SErrNoDatabaseName,self);
|
||||||
InitializeSQLite;
|
InitializeSQLite;
|
||||||
filename := DatabaseName;
|
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
|
if (Length(Password)>0) and assigned(sqlite3_key) then
|
||||||
checkerror(sqlite3_key(fhandle,PChar(Password),StrLen(PChar(Password))));
|
checkerror(sqlite3_key(fhandle,PChar(Password),StrLen(PChar(Password))));
|
||||||
if Params.IndexOfName('foreign_keys') <> -1 then
|
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 }
|
{ 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 }
|
{ the sign bits from the upper 16 bits are shifted in rather than }
|
||||||
{ zeroes. }
|
{ 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;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||||
begin
|
begin
|
||||||
Result := Word((AValue shr 8) or (AValue shl 8));
|
Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
|
||||||
end;
|
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 }
|
{ 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 }
|
{ the sign bits from the upper 16 bits are shifted in rather than }
|
||||||
{ zeroes. }
|
{ 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;
|
end;
|
||||||
|
|
||||||
{$ifndef cpujvm}
|
{$ifndef cpujvm}
|
||||||
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||||
begin
|
begin
|
||||||
Result := Word((AValue shr 8) or (AValue shl 8));
|
Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
|
||||||
end;
|
end;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
|
@ -596,38 +596,35 @@ begin
|
|||||||
lastentry := Nil;
|
lastentry := Nil;
|
||||||
entry := ThreadQueueHead;
|
entry := ThreadQueueHead;
|
||||||
while Assigned(entry) do begin
|
while Assigned(entry) do begin
|
||||||
{ first check for the thread }
|
if
|
||||||
if Assigned(aThread) and (entry^.Thread <> aThread) and (entry^.ThreadID <> aThread.ThreadID) then begin
|
{ 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;
|
lastentry := entry;
|
||||||
entry := entry^.Next;
|
entry := entry^.Next;
|
||||||
Continue;
|
|
||||||
end;
|
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;
|
end;
|
||||||
{$ifdef FPC_HAS_FEATURE_THREADING}
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
finally
|
finally
|
||||||
|
@ -341,6 +341,16 @@ function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
|
|||||||
function Size(AWidth, AHeight: Integer): TSize; inline;
|
function Size(AWidth, AHeight: Integer): TSize; inline;
|
||||||
function Size(const ARect: TRect): TSize;
|
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
|
implementation
|
||||||
|
|
||||||
Uses Math;
|
Uses Math;
|
||||||
@ -712,4 +722,44 @@ begin
|
|||||||
bottom:=bottom+dy; top:=top+dy;
|
bottom:=bottom+dy; top:=top+dy;
|
||||||
end;
|
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.
|
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 }
|
{ 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 }
|
{ the sign bits from the upper 16 bits are shifted in rather than }
|
||||||
{ zeroes. }
|
{ 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;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||||
begin
|
begin
|
||||||
Result := Word((AValue shr 8) or (AValue shl 8));
|
Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
|
||||||
end;
|
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