Forum > General

TFPGMap issue after upgrade to FPC 3.2.0

<< < (2/4) > >>

engkin:
"For reference counted interface objects, TFPGMapInterfacedObjectData must be used."

antispam88:
I have now changed TFPGMap to TFPGMapInterfacedObject and TFPGList to TFPGInterfacedObjectList.
So I was able to start our application.
But when I adjust the items of one of our TFPGInterfacedObjectList instances I'm getting an access violation because of accessing a freeed object (reference count is 0).

I have attached an example. The TFPGInterfacedObjectList is doing same as in our application. The TFPGList is working as expected.

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---ITestInterface = interface(IUnknown)    ['{734C54C2-BF68-4140-8DB4-8F1416A0545C}']    function GetName: string;    procedure SetName(const aname: string);    function GetRefCount: integer;  end;   TTestInterfacedList = specialize TFPGInterfacedObjectList<ITestInterface>;  TTestStandardList = specialize TFPGList<ITestInterface>;   TTestObject = class(TInterfacedObject, ITestInterface)  protected    _name: string;  public    function GetName: string;    procedure SetName(const aname: string);    function GetRefCount: integer;  end;...procedure TForm1.BtInitInterfacedClick(Sender: TObject);var  i: integer;begin  GroupBox2.Enabled := False;  for i := 0 to 15 do  begin    WriteLn('Init: ', _interface1.GetName, ' ', _interface1.GetRefCount);    _test_interfaced_list.Add(_interface1);  end;  BtAdjustInterfaced.Enabled := True;end; procedure TForm1.BtAdjustStandardClick(Sender: TObject);var  interface_cur: ITestInterface;  interface_new: ITestInterface;  i: integer;begin  for i := 0 to 15 do  begin    WriteLn('Adjust: ', _test_standard_list.Items[i].GetName, ' ',      _test_standard_list.Items[i].GetRefCount);    interface_cur := _test_standard_list.Items[i];    if (i < 8) or (i > 11) then    begin      interface_new := TTestObject.Create;      interface_new.SetName('interface ' + IntToStr(i));      _test_standard_list.Items[i] := interface_new;    end    else    begin      _test_standard_list.Items[i] := _interface1;    end;    interface_cur := nil;  end;end; procedure TForm1.BtAdjustInterfacedClick(Sender: TObject);var  interface_cur: ITestInterface;  interface_new: ITestInterface;  i: integer;begin  for i := 0 to 15 do  begin    try      WriteLn('Adjust: ', _test_interfaced_list.Items[i].GetName, ' ',        _test_interfaced_list.Items[i].GetRefCount);      interface_cur := _test_interfaced_list.Items[i];      if (i < 8) or (i > 11) then      begin        interface_new := TTestObject.Create;        interface_new.SetName('interface ' + IntToStr(i));        _test_interfaced_list.Items[i] := interface_new;      end      else      begin        _test_interfaced_list.Items[i] := _interface1;      end;      interface_cur := nil;    except      on e: Exception do      begin        WriteLn(e.Message);        raise;      end;    end;  end;end; procedure TForm1.BtInitStandardClick(Sender: TObject);var  i: integer;begin  GroupBox1.Enabled := False;  for i := 0 to 15 do  begin    WriteLn('Init: ', _interface1.GetName, ' ', _interface1.GetRefCount);    _test_standard_list.Add(_interface1);  end;  BtAdjustStandard.Enabled := True;end;
Do I use the TFPGInterfacedObjectList in a correct way?

Best regards,
antispam88

FPC: 3.2.0
Lazarus: 2.0.12
Win 10 x64

Thaddy:
Is the interface COM or CORBA?

antispam88:
{$interfaces CORBA} is not defined, so I assume it is COM, or?

ASerge:
A simpler example:

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---{$MODE OBJFPC}{$APPTYPE CONSOLE} uses SysUtils, fgl; type  TIntfObjectList = specialize TFPGInterfacedObjectList<IInterface>;  //TIntfObjectList = specialize TFPGList<IInterface>; procedure Test;var  SomeInstance: IInterface;  List: TIntfObjectList;  i: Integer;begin  SomeInstance := TInterfacedObject.Create;  List := TIntfObjectList.Create;  try    for i := 0 to 2 do    begin      List.Add(SomeInstance);      Writeln(i, ': ', (SomeInstance as TInterfacedObject).RefCount);    end;    Writeln;    for i := 0 to 2 do    begin      Writeln(i, ': ', (SomeInstance as TInterfacedObject).RefCount);      List[i] := nil;    end;  finally    List.Free;  end;end; begin  try    Test;  except    on E: Exception do      Writeln(E.Message);  end;  Readln;end.

Navigation

[0] Message Index

[#] Next page

[*] Previous page

Go to full version