[SOLVED] TFPGObjectList strange behavior

[Phoenix]

Hi,
I have some basic code here, but I don't understand the behavior. Why does it fail if I swap "manually" and work if I use "exchange"?

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4. {$APPTYPE CONSOLE}
5.  
6. {$define TEST_FAIL}
7.  
8. interface
9.  
10. uses
11.  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
12.  fgl;
13.  
14. type
15.  
16.  { TData }
17.  
18.  TData = class
19.   private
20.    fLayer: TObject;
21.   public
22.    constructor Create;
23.    destructor Destroy; override;
24.  end;
25.  
26.  { TDataList }
27.  
28.  TDataList = class(specialize TFPGObjectList<TData>)
29.   public
30.    procedure Execute(AFrom,ATo: Integer);
31.  end;
32.  
33.  { TForm1 }
34.  
35.  TForm1 = class(TForm)
36.   TEST: TButton;
37.   procedure FormCreate(Sender: TObject);
38.   procedure FormDestroy(Sender: TObject);
39.   procedure TESTClick(Sender: TObject);
40.  private
41.   fList: TDataList;
42.  
43.  public
44.  
45.  end;
46.  
47. var
48.  Form1: TForm1;
49.  
50. implementation
51.  
52. {$R *.lfm}
53.  
54. { TData }
55.  
56. constructor TData.Create;
57. begin
58.  inherited;
59.  fLayer:= TObject.Create;
60. end;
61.  
62. destructor TData.Destroy;
63. begin
64.  fLayer.Free;
65.  inherited;
66. end;
67.  
68. { TDataList }
69.  
70. procedure TDataList.Execute(AFrom,ATo: Integer);
71.  
72.  procedure Show(AComment: String);
73.  var
74.   i: Integer;
75.  begin
76.   WriteLn('#'+AComment);
77.   for i:= AFrom to ATo do
78.    WriteLn(PtrUInt(Items[i]),' | ',PtrUInt(Items[i].fLayer));
79.   WriteLn('#');
80.  end;
81.  
82. var
83.  tmp: TData;
84. begin
85.  Show('BEFORE');
86.  
87.  {$ifdef TEST_FAIL}
88.   tmp:= Items[AFrom];
89.   Items[AFrom]:= Items[ATo];
90.   Items[ATo]:= tmp;
91.  {$else}
92.   Exchange(AFrom,ATo);
93.  {$endif}
94.  
95.  Show('AFTER');
96. end;
97.  
98. { TForm1 }
99.  
100. procedure TForm1.FormCreate(Sender: TObject);
101. var
102.  i: Integer;
103. begin
104.  fList:= TDataList.Create;
105.  for i:= 1 to 5 do
106.   fList.Add( TData.Create );
107. end;
108.  
109. procedure TForm1.FormDestroy(Sender: TObject);
110. begin
111.  fList.Free;
112. end;
113.  
114. procedure TForm1.TESTClick(Sender: TObject);
115. begin
116.  fList.Execute(0,fList.Count-1);
117. end;
118.  
119. end.
120.  

as you can see from the image, the exchange happens but the layer pointer is "lost" 

Windows 10 64bit
FPC 3.2.2 Laz 3.6

[jamie]

My guess is you are overwriting an existing item when setting it and the object is freeing it as it supposed to do by default The Exchange however it's just  deeper and it simply exchanges as you would expect.

Sent de my phone.

[Phoenix]

Thanks  jamie

Yes, in the end, nothing really strange; the object was free. But this implementation choice, even if correct, leads to the possibility of a crash rather than a possible memory leak (if you don't complete the exchange). Unfortunately, I had a crash on a very large piece of code, and it took me a while to understand  .

[eny]

On the assignment of the item the previous object is freed, on line 89.

[BrunoK]

[EDIT: considering

will, maybe, revise answer]

Might be associated with https://gitlab.com/freepascal.org/fpc/source/-/issues/40840

Try the following code that seems to handle the TFPGObjectList create correctly.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4. {$APPTYPE CONSOLE}
5.  
6. { $define TEST_FAIL}
7.  
8. interface
9.  
10. uses
11.  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
12.  fgl, heaptrc;
13.  
14. type
15.  
16.  { TData }
17.  
18.  TData = class
19.   private
20.    fLayer: TObject;
21.   public
22.    constructor Create;
23.    destructor Destroy; override;
24.  end;
25.  
26.  { TDataList }
27.  
28.  TDataList = class(specialize TFPGObjectList<TData>)
29.   public
30.    procedure Execute(AFrom,ATo: Integer);
31.    constructor Create;
32.  end;
33.  
34.  { TForm1 }
35.  
36.  TForm1 = class(TForm)
37.   TEST: TButton;
38.   procedure FormCreate(Sender: TObject);
39.   procedure FormDestroy(Sender: TObject);
40.   procedure TESTClick(Sender: TObject);
41.  private
42.   fList: TDataList;
43.  
44.  public
45.  
46.  end;
47.  
48. var
49.  Form1: TForm1;
50.  
51. implementation
52.  
53. {$R *.lfm}
54.  
55. { TData }
56.  
57. constructor TData.Create;
58. begin
59.  inherited;
60.  fLayer:= TObject.Create;
61. end;
62.  
63. destructor TData.Destroy;
64. begin
65.  fLayer.Free;
66.  inherited;
67. end;
68.  
69. { TDataList }
70.  
71. procedure TDataList.Execute(AFrom,ATo: Integer);
72.  
73.  procedure Show(AComment: String);
74.  var
75.   i: Integer;
76.  begin
77.   WriteLn('#'+AComment);
78.   for i:= AFrom to ATo do
79.    WriteLn(PtrUInt(Items[i]),' | ',PtrUInt(Items[i].fLayer));
80.   WriteLn('#');
81.  end;
82.  
83. var
84.  tmp: TData;
85. begin
86.  Show('BEFORE');
87.  
88.  {$ifdef TEST_FAIL}
89.   tmp:= Items[AFrom];
90.   Items[AFrom]:= Items[ATo];
91.   Items[ATo]:= tmp;
92.  {$else}
93.   Exchange(AFrom,ATo);
94.  {$endif}
95.  
96.  Show('AFTER');
97. end;
98.  
99. constructor TDataList.Create;
100. begin
101.   inherited Create; // <-- bug in compiler, TFPGObjectList<TData> does not
102.                     //     call inherited TFPSList.Create with the size of
103.                     //     of type<T>
104.   TFPSList(Self).Create(TData.InstanceSize); // "Patch" InstanceSize to
105.     // self as TFPSList FItemSize. Note the calling a constructor with a
106.     // already Created object calls create as a normal procedure.
107.  
108. end;
109.  
110. { TForm1 }
111.  
112. procedure TForm1.FormCreate(Sender: TObject);
113. var
114.  i: Integer;
115. begin
116.  fList:= TDataList.Create;
117.  for i:= 1 to 5 do
118.   fList.Add( TData.Create );
119. end;
120.  
121. procedure TForm1.FormDestroy(Sender: TObject);
122. begin
123.  fList.Free;
124. end;
125.  
126. procedure TForm1.TESTClick(Sender: TObject);
127. begin
128.  fList.Execute(0,fList.Count-1);
129. end;
130.  
131. end.
132.  

[eny]

Might be associated with https://gitlab.com/freepascal.org/fpc/source/-/issues/40840

It's not. See above.

[Phoenix]

@BrunoK
Thanks for the info. In any case, even with the modified create method, the behavior doesn't change.
As @eny also pointed out, it's clearly shown in the code.

If you want to use manual exchange you also have to act on "FreeObjects" but using "exchange" is more efficient

 thank you all

[PascalDragon]

Yes, in the end, nothing really strange; the object was free. But this implementation choice, even if correct, leads to the possibility of a crash rather than a possible memory leak (if you don't complete the exchange). Unfortunately, I had a crash on a very large piece of code, and it took me a while to understand  .

For a correct manual exchange you would need to use Extract and then Insert (cause the original item position gets reused). That's why Exchange exists after all...

[Phoenix]

Indeed, the implementation is correct. My attention sometimes...  then a crash is not silent