Updating TPolygon items in generic List is difficult?

[Gustav Schubert 25]

I need an explanation, for this:

program PolyTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Types,
  System.Math.Vectors,
  System.Generics.Collections;

var
  P: TPolygon; // array of TPointF, see declaration in System.Math.Vectors
  L: TList<TPolygon>;

procedure Test(WantProblem: Boolean);
var
  Temp: TPolygon;
begin
  Temp := L[0] + P; // append to the existing polygon
  if WantProblem then
  begin
    L[0] := Temp; // <-- access violation here (sure at second attempt)
  end
  else
  begin
    L.Delete(0);
    L.Insert(0, Temp);
  end;
end;

begin
  try
    P := [TPointF.Create(0, 0), TPointF.Create(1, 1)];
    L := TList<TPolygon>.Create;
    try
      L.Add(P);

      Test(False);
      Test(False);

      WriteLn('Updating via Delete/Insert seems to work.');
      WriteLn('But why not via assigning?');
      WriteLn('Press Enter to continue...');
      ReadLn;

      Test(True);
      Test(True);
    finally
      L.Free;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;


  WriteLn('Program has finished.');
  WriteLn('Press Enter to close...');
  Readln;
end.

 

[PeterBelow 238]

I get no exception using D11.1 with this code.

[Gustav Schubert 25]

38 minutes ago, PeterBelow said:

no exception using D11.1

Good to know, I am using D10.1, perhaps a fixed bug, but I could not find a report in QP.

[Uwe Raabe 2057]

1 hour ago, Gustav Schubert said:

but I could not find a report in QP.

https://quality.embarcadero.com/browse/RSP-16511

[Gustav Schubert 25]

I started to debug and have already stopped, after verifying that the AV happens when calling DynArrayClear inside of TListHelper.DoSetItemDynArray.

procedure TListHelper.DoSetItemDynArray(const Value; AIndex: Integer);
begin
  try
    // ...
  finally
    DynArrayClear(OldItem, FTypeInfo); // in 10.1.2
    { DynArrayClear(OldItem, ElType); } // from 10.3.0
  end;
end;

Update: Now I see that the best explanation (so far) is at stackoverflow, I am coming late to the party, sorry.

 

https://stackoverflow.com/questions/41047688/how-to-work-around-delphi-10s-bug-with-tlist-anydynamicarrays

Edited August 4, 2022 by Gustav Schubert
link to stackoverflow added

[Gustav Schubert 25]

Reading the bug report is one thing, understanding it another. I am dumping my test program here. It shows how to display the reference count of the dynamic array in the list. Comments in button click method will serve as alternative explanation for the same old problem you don't have.

unit FrmMain;

interface

{
1. If you use new version of Delphi, please ignore.

2. In older version of Delphi, including Berlin, there is (known) bug.

3. Because of this bug (internal details already explained elsewhere)
the reference count of the TPolygon will not be incremented
when assigning to the list index.

4. When the assigned Polygon is a local variable
which goes out of scope at the end of the method,
it will be finalized and the list then contains a dangling pointer.

5. The AV only happens later, the next time the polygon is accessed.

6. The exception will likely be caught and handled by the debugger
and following this the assignment will succeed.
The newly assigned polygon will be usable,
  if the assigned polygon will not be finalized.

7. It is possible to monitor the reference count of the dynamic array.
Stackoverflow question 22163259 has the answer that shows how.

8. The test program below has a timer which will update a report,
which is showing the current ref count of the dynamic array in the list.

- Usually the ref count of the polygon in the list is two.
- After assigning a local variable with unique content it goes down to one.
- The next time you click, the exception may happen, and ref count will be two again.
- If assigning something that will not be finalized next,
  then the reference count can be left at one with no problem.

- The biggest problem is the dangling pointer that is left behind, if any.
- And the second biggest problem is the exception itself, which is not wanted.

9. Again, fixed in new version of Delphi!
}

uses
  Winapi.Windows,
  System.SysUtils,
  System.Classes,
  System.Types,
  System.StrUtils,
  System.UITypes,
  System.Math.Vectors,
  System.Generics.Collections,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.Objects;

type
  { for Delphi 10.1. Berlin }
  TFormMain = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    T: TText;
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    P1: TPolygon;
    P2: TPolygon;
    L: TList<TPolygon>;
    SL: TStringList;
    Counter: Integer;
    RefCountP1: Integer;
    RefCountP2: Integer;
    RefCountL0: Integer;
    procedure ShowContent;
    procedure SetupText;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

type
  { https://stackoverflow.com/questions/22163259/ }
  { how-i-determine-the-number-of-references-to-a-dynamic-array }
  PDynArrayRec = ^TDynArrayRec;
  TDynArrayRec = packed record
  {$IFDEF CPUX64}
    _Padding: LongInt; // Make 16 byte align for payload..
  {$ENDIF}
    RefCnt: LongInt;
    Length: NativeInt;
  end;

function DynArrayRefCount(P: Pointer): LongInt;
begin
  if P <> nil then
    Result := PDynArrayRec(PByte(P) - SizeOf(TDynArrayRec))^.RefCnt
  else
    Result := 0;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  P1 := [TPointF.Create(1, 1)];
  P2 := [TPointF.Create(2, 2)];
  L := TList<TPolygon>.Create;
  L.Add(P1);
  SL := TStringList.Create;
  SetupText;

  Timer.Interval := 500;

  Button7.Text := 'Reset';
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  L.Free;
  SL.Free;
end;

procedure TFormMain.TimerTimer(Sender: TObject);
begin
  ShowContent;
end;

procedure TFormMain.SetupText;
begin
  T.VertTextAlign := TTextAlign.Leading;
  T.Width := 200;
  T.Height := 500;
  T.Font.Size := 16;
{$ifdef MACOS}
  T.Font.Family := 'CourierNewPSMT';
{$else}
  T.Font.Family := 'Courier New';
{$endif}
  T.Font.Style := T.Font.Style + [TFontStyle.fsBold];
  T.Opacity := 1.0;
  T.Color := TAlphaColors.Cornflowerblue;
  T.HitTest := False;
end;

procedure TFormMain.ShowContent;
var
  P: TPointF;
  s: string;
begin
  if L.Count < 1 then
  begin
    T.Text := 'L is Empty';
    Exit;
  end;

  RefCountP1 := DynArrayRefCount(Pointer(P1));
  RefCountP2 := DynArrayRefCount(Pointer(P2));
  RefCountL0 := DynArrayRefCount(Pointer(L[0]));
  Inc(Counter);
  SL.Clear;
  SL.Add(IntToStr(Counter));
  SL.Add(Format('RecCountP1 = %d', [RefCountP1]));
  SL.Add(Format('RecCountP2 = %d', [RefCountP2]));
  SL.Add(Format('RecCountL0 = %d', [RefCountL0]));
  for P in L[0] do
  begin
    s := Format('(%.2f, %.2f)', [P.X, P.Y]);
    SL.Add(s);
  end;
  T.Text := SL.Text;
end;

procedure TFormMain.Button1Click(Sender: TObject);
begin
  { problem will show at this point when L.Items[0] is invalid }
//  CurrentRefCount := DynArrayRefCount(Pointer(L[0]));
//  if CurrentRefCount > 1 then
//  begin
    L.Items[0] := P1;
//  end;
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
  { this does not change anything }
  L[0] := L[0];
end;

procedure TFormMain.Button3Click(Sender: TObject);
var
  Temp: TPolygon;
  i: Integer;
begin
  { this is ok, if L[0] contains valid polygon }
  Temp := P1; // P1 will not be finalized after method ends
  i := DynArrayRefCount(Pointer(Temp));
//  Assert(i = 3);
  if not (i = 3) then
    Beep;
  L[0] := Temp;
end;

procedure TFormMain.Button4Click(Sender: TObject);
begin
  { will leave a dangling pointer in L[0] }
  L[0] := L[0] + P1;
end;

procedure TFormMain.Button5Click(Sender: TObject);
var
  Temp: TPolygon;
begin
  { will leave a dangling pointer in L[0] }
  Temp := L[0] + P1;
  L[0] := Temp;
end;

procedure TFormMain.Button6Click(Sender: TObject);
var
  Temp: TPolygon;
begin
  { will leave dangling pointer in L[0] }
  { but no exception here when clicked again }
  { because it is not accessed }
  Temp := P1 + P2;
  L.Delete(0);
  L.Insert(0, Temp);
end;

procedure TFormMain.Button7Click(Sender: TObject);
begin
  { Reset, ref count of L[0] will be two again.  }
  L.Clear;
  L.Add(P1);
end;

(*
https://stackoverflow.com/questions/45958714/
delphi-dynamic-array-reference-counting
*)

end.

 

Edited August 5, 2022 by Gustav Schubert
typo

[Gustav Schubert 25]

New Wheel: Special purpose Array with Add method and Count property, an attempt.

unit RiggVar.FederModel.ListArray;

interface

type
  TListArray<T> = class
  private
    FEmpty: T;
    FArray: TArray<T>;
    FLength: Integer;
    FCount: Integer;
    function GetItem(Index: Integer): T;
    procedure SetItem(Index: Integer; const Value: T);
  public
    constructor Create(ALength: Integer; AEmpty: T);
    procedure Clear;
    function Add(AItem: T): Integer;
    procedure Delete(Index: Integer);
    procedure Insert(Index: Integer; AItem: T);
    property Count: Integer read FCount;
    property Items[Index: Integer]: T read GetItem write SetItem; default;
  end;

{
  - Original use case: substitute for TList<TPolygon>
  - needed in Delphi 10.1 (work around RSP-16511)
  - It is intended for a known maximum number of items only.
}

implementation

{ TListArray<T> }

constructor TListArray<T>.Create(ALength: Integer; AEmpty: T);
begin
  FCount := 0;
  FLength := ALength;
  FEmpty := AEmpty;
  SetLength(FArray, FLength);
  Clear;
end;

procedure TListArray<T>.Clear;
var
  i: Integer;
begin
  FCount := 0;
  for i := 0 to FLength - 1 do
  begin
    FArray[i] := FEmpty;
  end;
end;

function TListArray<T>.GetItem(Index: Integer): T;
begin
  if (Index < 0) or (Index >= FCount) then
    result := FEmpty
  else
    result := FArray[Index];
end;

procedure TListArray<T>.SetItem(Index: Integer; const Value: T);
begin
  if (Index >= 0) and (Index < FLength) and (Index < FCount) then
    FArray[Index] := Value;
end;

function TListArray<T>.Add(AItem: T): Integer;
begin
  if FCount < FLength then
  begin
    FArray[FCount] := AItem;
    Inc(FCount);
    result := FCount;
  end
  else
    result := -1;
end;

procedure TListArray<T>.Delete(Index: Integer);
var
  I: Integer;
begin
  if (Index >= 0) and (Index < FLength) and (FCount > 0) and (Index < FCount) then
  begin
    for i := Index to FCount - 2 do
      FArray[i] := FArray[i + 1];
    FArray[FCount - 1] := FEmpty;
    Dec(FCount);
  end;
end;

procedure TListArray<T>.Insert(Index: Integer; AItem: T);
var
  i: Integer;
begin
  if (Index >= 0) and (Index < FCount) and (FCount < FLength) then
  begin
    for i := FCount downto Index + 1 do
      FArray[i] := FArray[i - 1];
    FArray[Index] := AItem;
    Inc(FCount);
  end;
end;

end.

 

Edited August 6, 2022 by Gustav Schubert