Skip to content

Delphi Tokyo support #14

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Delphi Tokyo support #14

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 19 additions & 9 deletions Core/Types/Next.Core.DisposableValue.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -156,14 +156,18 @@ procedure TDisposableValue<T>.TryDispose<T2>(const AOther: T2);
procedure TDisposableValue<T>.TryDisposeArray<T2>(const AOther: T2);
type
PObject = ^TObject;
var
i: Integer;
LValue, LArrayElement: TValue;
LObject: TObject;
begin
var LValue := TValue.From<T>(FValue);
LValue := TValue.From<T>(FValue);

for var i := 0 to LValue.GetArrayLength - 1 do begin
var LArrayElement := LValue.GetArrayElement(i);
for i := 0 to LValue.GetArrayLength - 1 do begin
LArrayElement := LValue.GetArrayElement(i);

if LArrayElement.Kind = tkClass then begin
var LObject := LArrayElement.AsObject;
LObject := LArrayElement.AsObject;

case GetTypeKind(T2) of

Expand All @@ -186,10 +190,13 @@ procedure TDisposableValue<T>.TryDisposeObject<T2>(const AOther: T2);
type
PObject = ^TObject;
PIntf = ^IInterface;
var
LIntf: IInterface;
LObj: TObject;
begin
if (GetTypeKind(T2) = tkInterface) then begin
var LIntf := (PIntf(@AOther)^ as IInterface);
var LObj := LIntf as TObject;
LIntf := (PIntf(@AOther)^ as IInterface);
LObj := LIntf as TObject;
if (PObject(@FValue)^ <> PObject(@LObj)^) then
DisposeP(FValue)
else
Expand All @@ -199,13 +206,16 @@ procedure TDisposableValue<T>.TryDisposeObject<T2>(const AOther: T2);
end;

function TDisposableValue<T>.ObjectInArray<T2>(const AObject: TObject; const AArray: T2): Boolean;
var
LArray, LArrayElement: TValue;
j: Integer;
begin
Result := False;

var LArray := TValue.From<T2>(AArray);
for var j := 0 to LArray.GetArrayLength - 1 do begin
LArray := TValue.From<T2>(AArray);
for j := 0 to LArray.GetArrayLength - 1 do begin

var LArrayElement := LArray.GetArrayElement(j);
LArrayElement := LArray.GetArrayElement(j);
if (LArrayElement.Kind = tkClass) then

if LArray.GetArrayElement(j).AsObject = AObject then
Expand Down
27 changes: 16 additions & 11 deletions Core/Types/Next.Core.Promises.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -381,15 +381,12 @@ function TAbstractPromise<T>.&Finally(AProc: TProc): IPromise<T>;
end;

function TAbstractPromise<T>.Await: T;
var
LException: Exception;
begin
InternalWait;

System.TMonitor.Enter(Self);
try
if State = psRejected then begin
LException := GetFailure.Reason;
raise GetFailure.DetachExceptionObject;
end else if State = psFullfilled then begin
Result := FValue;
Expand Down Expand Up @@ -514,6 +511,7 @@ procedure TAbstractPromise<T>.InternalWait(ATimeout: Cardinal);
MT_SYNC_WAIT = 10;
var
LRunning: Cardinal;
LResult: TWaitResult;
begin
if State = psPending then begin
if TThread.CurrentThread.ThreadID = MainThreadID then begin
Expand All @@ -523,7 +521,7 @@ procedure TAbstractPromise<T>.InternalWait(ATimeout: Cardinal);
LRunning := LRunning + MT_SIGNAL_WAIT + MT_SYNC_WAIT;
end;
end else begin
var LResult := FSignal.WaitFor(ATimeout);
LResult := FSignal.WaitFor(ATimeout);
if LResult <> TWaitResult.wrSignaled then
raise EInternalWaitProblem.Create('Issue waiting for signal (not set before timeout?): ' + GetEnumName(TypeInfo(TWaitResult), Ord(LResult)));
end;
Expand Down Expand Up @@ -975,6 +973,13 @@ procedure TPromiseScheduler.ControlPool;
{$ENDIF}
{$IFNDEF MSWINDOWS}
LEvents: Array[0..1] of THandleObject;
{$ENDIF}
LCancel: Boolean;
i: Integer;
LThread: TPromiseThread;
LWaitResult: Integer;
LRevisionBefore, LRevisionAfter: Int64;
{$IFNDEF MSWINDOWS}
const
WAIT_OBJECT_0 = 0;
{$ENDIF}
Expand All @@ -987,39 +992,39 @@ procedure TPromiseScheduler.ControlPool;
LEvents[0] := FCancel;
LEvents[1] := FSignalController;
{$ENDIF}
var LCancel := False;
LCancel := False;

for var i := 0 to MIN_POOL_SIZE - 1 do
for i := 0 to MIN_POOL_SIZE - 1 do
AddThread();

while (not LCancel) do begin
{$IFDEF MSWINDOWS}
const LWaitResult = WaitForMultipleObjectsEx(2, @LEvents, False, INFINITE, False);
LWaitResult := WaitForMultipleObjectsEx(2, @LEvents, False, INFINITE, False);
{$ENDIF}
{$IFNDEF MSWINDOWS}
const LWaitResult = WaitForMultipleEvents(LEvents);
LWaitResult := WaitForMultipleEvents(LEvents);
{$ENDIF}
case LWaitResult of
WAIT_OBJECT_0: LCancel := True;

WAIT_OBJECT_0 + 1: begin
FSignalController.ResetEvent;
const LRevisionBefore = TInterlocked.Read(FSignalControllerRevision);
LRevisionBefore := TInterlocked.Read(FSignalControllerRevision);

if GrowPool() then begin
//Take it easy, only grow/shrink every 100ms
if FCancel.WaitFor(100) = wrSignaled then
LCancel := True;
end;

const LRevisionAfter = TInterlocked.Read(FSignalControllerRevision);
LRevisionAfter := TInterlocked.Read(FSignalControllerRevision);
if LRevisionBefore <> LRevisionAfter then
SignalControllerIf();
end;
end;
end;

for var LThread in FThreads do begin
for LThread in FThreads do begin
LThread.Cancel;
LThread.WaitFor;
LThread.Free;
Expand Down