Primož Gabrijelčič

You have:

  Renderer := Parallel.ParallelTask.NumTasks(numTasks).NoWait
    .Execute(
      procedure
      begin
        workItem := RenderQueue.Next;
        ...
      end);

and then:

  for iTask := 0 to numTasks-1 do begin
    TileSource := workItem.Data['TileSource' + iTask.ToString];
    RenderQueue.Add(TOmniValue.Create([iTask, TileSource]));
  end;

If you change only the parameter to `ParallelTask.NumTasks`, some tasks won't ever get data because you'll schedule only `numTasks` items to `RenderQueue`.

Do we have any neat solution for that problem?

I can change `IWorkItem` to:

IWorkItem = interface ['{7C583FC8-90DD-46A5-81B9-81B911AA1CBE}']
  function GetResult: POmniValue;
  procedure SetResult(const Value: TOmniValue);
  property Result: POmniValue read GetResult;
end;

This allows me to use:

workItem.Result.AsOwnedObject := TTestObj.Create;

But it also prevents me from doing:

workItem.Result := TTestObj.Create;

Which is more common usage. 

Grrrrr!

`workItem.Result` is a record property. Because of that, this code:

 workItem.Result.AsOwnedObject := TBitmap32.Create(256,256);

is equivalent to running:

var tmp: TOmniValue;

tmp := workItem.Result;
tmp.AsOwnedObject := TBitmap32.Create(256,256);

And that fails. You should change the code to:

var tmp: TOmniValue;

tmp.AsOwnedObject := TBitmap32.Create(256,256);
workItem.Result := tmp;

I'll see if I can change the implementation of `IOmniWorkitem` to prevent such problems.

Doh! I knew I was just stupid.

To recap (for people who don't want to dig through ton of code).

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
end;

is equivalent to:

procedure Test(const workItem: IWorkItem);
var
  tmp: TOmniValue;
begin
  tmp := workItem.Result;
  tmp.AsOwnedObject := TTestObj.Create;
end;

To do it correctly, one must change the code to:

procedure Test(const workItem: IWorkItem);
var
  ov: TOmniValue;
begin
  ov.AsOwnedObject := TTestObj.Create;
  workItem.Result := ov;
end;

Thank you, guys!

Minimized problem: 

Maybe somebody can tell me what is going on because I'm clueless.

Dear all,

I'm being stupid and I can't figure why in the following code the `TTestObj` is destroyed before its owner. Can you please help?

Full code is available here and is also posted at the end of this post.

Basically, I have an interface `IWorkItem` which owns record `TOmniValue` which owns interface `IAutoDestroyObject`.

The code creates an instance of `IWorkItem` and then calls:

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
end;

This sets the `IAutoDestroyObject` field of the nested `TOmniValue` record.

When the `Test` function exits (during the procedure finalization code) this `TTestObj` gets destroyed, and I can't figure out why.

program ObjectDestroyedTooSoon;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils;

type
  TTestObj = class
  public
    destructor Destroy; override;
  end;

  IAutoDestroyObject = interface ['{30CF4CCF-9383-41C0-BBA3-E24F7C4EFF71}']
    function  GetObj: TObject;
    property Obj: TObject read GetObj;
  end;

  TAutoDestroyObject = class(TInterfacedObject, IAutoDestroyObject)
  strict private
    FObject: TObject;
  protected
    function GetObj: TObject;
  public
    constructor Create(obj: TObject);
    destructor  Destroy; override;
    property Obj: TObject read GetObj;
  end;

  TOmniValue = record
  private
    FOwnedObject: IAutoDestroyObject;
    function GetAsOwnedObject: TObject;
    procedure SetAsOwnedObject(const Value: TObject);
  public
    property AsOwnedObject: TObject read GetAsOwnedObject write SetAsOwnedObject;
  end;

  IWorkItem = interface ['{7C583FC8-90DD-46A5-81B9-81B911AA1CBE}']
    function GetResult: TOmniValue;
    procedure SetResult(const Value: TOmniValue);
    property Result: TOmniValue read GetResult write SetResult;
  end;

  TWorkItem = class(TInterfacedObject, IWorkItem)
  strict private
    FResult: TOmniValue;
  strict protected
    function GetResult: TOmniValue;
    procedure SetResult(const Value: TOmniValue);
  public
    destructor Destroy; override;
    property Result: TOmniValue read GetResult write SetResult;
  end;

{ TTestObj }

destructor TTestObj.Destroy;
begin
  Writeln('TTestObj destroyed');
  inherited;
end;

{ TWorkItem }

destructor TWorkItem.Destroy;
begin
  Writeln('TWorkItem destroyed');
  inherited;
end;

function TWorkItem.GetResult: TOmniValue;
begin
  Result := FResult;
end;

procedure TWorkItem.SetResult(const Value: TOmniValue);
begin
  FResult := Value;
end;

{ TOmniValue }

function TOmniValue.GetAsOwnedObject: TObject;
begin
  Result := FOwnedObject.Obj;
end;

procedure TOmniValue.SetAsOwnedObject(const Value: TObject);
begin
  FOwnedObject := TAutoDestroyObject.Create(Value);
end;

{ TAutoDestroyObject }

constructor TAutoDestroyObject.Create(obj: TObject);
begin
  inherited Create;
  FObject := obj;
end;

destructor TAutoDestroyObject.Destroy;
begin
  FreeAndNil(FObject);
  inherited;
end;

function TAutoDestroyObject.GetObj: TObject;
begin
  Result := FObject;
end;

{ main }

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
end;

var
  workItem: IWorkItem;

begin
  try
    workItem := TWorkItem.Create;
    Test(workItem);
    Writeln('After Test');
    workItem := nil;
    Writeln('workItem destroyed');
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Indeed, if you set `workItem.Result` as owned object, it gets destroyed immediately after the `Asy_Execute` exits.

This is the minimal code that reproduces the problem:

procedure TfrmBackgroundWorkerImageFactory.Asy_Factory(const workItem: IOmniWorkItem);
begin
  if not workItem.CancellationToken.IsSignalled then
    workItem.Result.AsOwnedObject := TBitmap32.Create(256,256);
end;

At the moment, don't use `OwnsObject` or `AsOwnedObject` at that point. I'll dig in to see what's going on.

11 hours ago, Anders Melander said:

I believe this was addressed recently in Graphics32: TBitmap32 constructor access violation

TNX. I have to update, obviously 🙂

Create a reproducible test case and post i here.

BTW, why are you createing 4000 tasks? Surely, there's a better way to solve your problem.

I see accvio in G32.pas in

procedure TCustomBitmap32.ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer);
begin
  FBackend.ChangeSize(Width, Height, NewWidth, NewHeight);
end;

FBackend is nil

Sorry, no idea why.

Don't think so as we don't use crazily big sets. Plus this code is mostly used for compatibility reason; because some old configuration files store enum and set data as integers.

But of course, all code that can fail, will fail.

2 hours ago, Attila Kovacs said:

I've lost the thread after this line "As it turns out, we can fix both problems simply by using class variables, properties, and methods functionality of the Delphi language:"

The same code follows as already above the paragraph was., instead of the declaration of "TypeInfoCache" I think.

Copy&paste bug, sorry. Was OK on the blog, wrong here in the forum. Corrected.

Thank you!

It works for our code 🙂 We don't pass large sets through that function and everything is fine. 

Exactly - I somehow deleted that line from the gist, while still keeping it in my local copy of the code. 😞 😞 😞

(Actually, this Move should not be 'if'-ed. Just always execute it.)

I'll fix my blog, gist example and this post when I come home later today.

Thank you for finding the bug!

Original post: https://www.thedelphigeek.com/2019/01/caching-with-class-variables.html

type
  Range<T> = record
  private
    class function MaxIntVal: Integer; static; inline;
    class function MinIntVal: Integer; static; inline;
  public
    class function Check(const value: Integer): T; static;
  end;

class function Range<T>.Check(const value: Integer): T;
begin
  if (value < MinIntVal) or (value > MaxIntVal) then
    raise Exception.CreateFmt(
      'Value %d lies outside allowed range for %s (%d .. %d)',
      [value, PTypeInfo(TypeInfo(T)).Name, MinIntVal, MaxIntVal]);
  Move(value, Result, SizeOf(Result));
end;

type
  TEnum = (en1, en2, en3);
  TEnumSet = set of TEnum;

var
  en: TEnum;
  ens: TEnumSet;

en := Range<TEnum>.Check(2); // OK, en = en3
en := Range<TEnum>.Check(3); // exception

ens := Range<TEnumSet>.Check(0); // OK, ens = []
ens := Range<TEnumSet>.Check(8); // exception

class function Range<T>.MaxIntVal: Integer;
var
  ti: PTypeInfo;
  typeData: PTypeData;
  isSet: Boolean;
  i: Integer;
begin
  ti := TypeInfo(T);
  isSet := ti.Kind = tkSet;
  if isSet then
    ti := GetTypeData(ti).CompType^;
  typeData := GetTypeData(ti);
  if isSet then
  begin
    Result := 0;
    for i := typeData.MinValue to typeData.MaxValue do
      Result := Result or (1 shl i);
  end
  else
    Result := typeData.MaxValue;
end;

class function Range<T>.MinIntVal: Integer;
var
  ti: PTypeInfo;
  typeData: PTypeData;
begin
  ti := TypeInfo(T);
  if ti.Kind = tkSet then
    ti := GetTypeData(ti).CompType^;
  typeData := GetTypeData(ti);
  Result:= typeData.MinValue;
end;

type
  TypeInfoCache<T> = class
  class var
    FMinIntVal: Integer;
    FMaxIntVal: Integer;
  public
    class constructor Create;
    class property MaxIntVal: Integer read FMaxIntVal;
    class property MinIntVal: Integer read FMinIntVal;
  end;

class constructor TypeInfoCache<T>.Create;
var
  ti: PTypeInfo;
  typeData: PTypeData;
  isSet: Boolean;
  i: Integer;
begin
  ti := TypeInfo(T);
  isSet := ti.Kind = tkSet;
  if isSet then
    ti := GetTypeData(ti).CompType^;
  typeData := GetTypeData(ti);
  FMinIntVal := typeData.MinValue;

  if isSet then
  begin
    FMaxIntVal := 0;
    for i := typeData.MinValue to typeData.MaxValue do
      FMaxIntVal := FMaxIntVal or (1 shl i);
  end
  else
    FMaxIntVal := typeData.MaxValue;
end;

class function Range<T>.MaxIntVal: Integer
begin
  Result := TypeInfoCache<T>.MaxIntVal;
end;

class function Range<T>.MinIntVal: Integer;
begin
  Result := TypeInfoCache<T>.MinIntVal;
end;

Pipeline would work as you can run each stage in more than one parallel task (by using .NumTasks). But Parallel.BackgroundWorker is probably more appropriate.

I'm playing with Live Bindings and looking at how far I can push it 🙂 ...

I wanted to see if I can take a single-item source (edit box) and bind it to a list-type control (list box), somehow splitting the data in the process. This is what I ended at:

1. Bind expression that binds Edit1, Text to ListBox1, Items.DelimitedText.

2. OnAssigningValue event for that bind expression:

procedure TForm85.BindExpression1AssigningValue(Sender: TObject; AssignValueRec:
  TBindingAssignValueRec; var Value: TValue; var Handled: Boolean);
begin
  Value := StringReplace(Value.AsString, ', ', ',', [rfReplaceAll]);
end;
 

(This allows me to type in "1, 2, 3" or "1,2,3" and both split into "1", "2", and "3".)

3. Edit1.OnChangeTracking which updates the expression:

procedure TForm85.Edit1ChangeTracking(Sender: TObject);
begin
  BindingsList1.Notify(Sender, 'Text');
end;
 

4. Some initialization for DelimitedText to work correctly:

  ListBox1.Items.Delimiter := ',';
  ListBox1.Items.StrictDelimiter := true;

Demo project is attached.

Does anyone see a better solution for that? (Better = requires writing less code.)

(No need to tell me that my problem is stupid and that I should redesign my app so that I don't have to do any splitting of data. I know that. This is an exercise.)

liveb.zip

Was IDE Fix Pack merged into 10.3 release?

This looks like a bug in OTL. Can you please create a small, self-contained, compilable example so I can retest?

As a workaround, why do you need Task1 to monitor Task2? This should work equally well:

procedure RunTask;
begin
  Task2 := CreateTask(
            procedure(const mTask: IOmniTask)
            begin
              ...
            end)
            .OnTerminated(procedure(const mTask: IOmniTaskControl)
              begin
                Task2 := nil;
                RunTask;
              end);
  Task2.Run;
end;

When I need a busy loop I usually just do

a := 1;
while not timeout do
  a := Cos(a);

"Might or might not". 

Sleep is a good tool to demonstrate a bug. But I agree with you - if it works with Sleep, it still may not work with a high CPU load code. So proving with "Sleep" that the library works is not good enough. OTOH, proving with a high CPU load code that it works is also not good enough. 

"Unit tests can only be used to prove that a parallel code is NOT working."

- me

(BTW, I know that we agree here 🙂 I just wanted to state that testing parallel code with Sleep is a perfectly good tool. It is just not good enough.)

5 minutes ago, Stefan Glienke said:

No offense but I cannot take people serious that test any threading library code by putting sleep into their thread execution to simulate any real workload...

Because?

Unless the thread pool manager is measuring CPU load, the result should be the same. And if the thread pool manager does that, it is easy to replace the code with a busy loop. As far as my bug hunting in Delphi's TThreadPool went, replacing Sleep(2000) with a 2 second busy loop never changed anything.

How do you delete the folder? By deleting files one by one and the removing the parent folder? In that case, you may want to execute cmd /c rmdir /q /s target_folder from your program. Should be much faster.

The biggest problem with PPL (apart from number of terrifying bugs that were only recently fixed) is the annoying and uncontrollable behavior of its thread pool. It will start threads as it seems appropriate, sometimes seemingly without considering min/max concurrent tasks configuration (of which the 'min' part is actually not, as per source, see below).

// Returns false if attempting to set a value < 0 or > MaxWorkerThreads. The actual number of pool
// threads could be less than this value depending on actual demand. Setting this to too few threads could
// be less than optimal resource utilization.
function SetMinWorkerThreads(Value: Integer): Boolean;

(BTW, the comment suggests that MinWorkerThreads can be set to the same value as MaxWorkerThreads. This is not the case. It must be less than that.)

"Annoying and uncontrollable behavior": Sometimes you schedule N threads, then wait, then schedule M (M > N, but M < MaxWorkerThreads) threads, but only N would start. I can repeatedly reproduce this in Tokyo (and Berlin, and Seattle ...). The problem was mostly, but not completely, fixed in Rio. I noticed some problems there, too, but at the moment I don't yet know how to reproduce the problem from scratch.

I don't understand how that should work. "Several windows are interested in receiving messages from the queue" - are they then fighting to fetch that message? 

It is quite possible that something goes wrong in such case. I don't believe I ever tested such setup.

Can you get me a sample program so I can repeat the problem?