Delphi 2009, already released interface

I need a special entry with an interface.

and the interface has a child interface and some class. therefore, automatic release is needed. but, the interface in the recording is already released.

need help, why is linkmatch missmatch?

I try the following code ...

// --------------------------------------------- --- --------------------

type IIn = interface procedure SetValue(v : string); function AsString() : string; function GetChild() : IIn; end; RIn = record FIn : IIn; procedure SetInterface(intf : IIn); procedure SetValue(v : string); function AsString() : string; function GetChild() : RIn; end; TIn = class(TInterfacedObject, IIn) private FChild : IIn; FValue : string; public procedure SetValue(v : string); function AsString() : string; function GetChild() : IIn; end; 

// --------------------------------------------- --- --------------------

 procedure RIn.SetInterface(intf : IIn); begin FIn := intf; end; function RIn.GetChild() : RIn; var childInterface : IIn; begin if FIn = nil then FIn := TIn.Create(); childInterface := FIn.GetChild(); Result.SetInterface( childInterface ); end; procedure RIn.SetValue(v : string); begin if FIn = nil then FIn := TIn.Create(); FIn.SetValue(v); end; function RIn.AsString() : string; begin if FIn = nil then FIn := TIn.Create(); Result := FIn.AsString(); end; function RIn.GetRefCnt() : integer; begin if FIn = nil then FIn := TIn.Create(); Result := FIn.GetRefCnt(); end; procedure TIn.SetValue(v : string); begin FValue := v; end; function TIn.AsString() : string; begin Result := FValue; end; function TIn.GetChild() : IIn; begin if FChild = nil then FChild := TIn.Create(); Result := FChild; end; 

// --------------------------------------------- --- --------------------

 // global var var test : RIn; // test procedure 1 procedure test1; begin test.GetChild().SetValue('test...'); end; // test procedure 2 procedure test2; begin ShowMessage( test.GetChild().AsString ); <----- Error!! child interface is already released.. end; 
+4
source share
1 answer

This is a Delphi 2009 link count error. I modified your code a bit to display link counts:

 program Bug2009; {$APPTYPE CONSOLE} uses SysUtils; type IIn = interface procedure SetValue(v : string); function AsString() : string; function GetChild() : IIn; end; RIn = record FIn : IIn; procedure SetInterface(intf : IIn); procedure SetValue(v : string); function AsString() : string; function GetChild() : RIn; end; TIn = class(TInterfacedObject, IIn) private FChild : IIn; FValue : string; public procedure SetValue(v : string); function AsString() : string; function GetChild() : IIn; end; procedure RIn.SetInterface(intf : IIn); begin FIn := intf; end; function RIn.GetChild() : RIn; var childInterface : IIn; begin if FIn = nil then FIn := TIn.Create(); childInterface := FIn.GetChild(); Result.SetInterface( childInterface ); end; procedure RIn.SetValue(v : string); begin if FIn = nil then FIn := TIn.Create(); FIn.SetValue(v); end; function RIn.AsString() : string; begin if FIn = nil then FIn := TIn.Create(); Result := FIn.AsString(); end; procedure TIn.SetValue(v : string); begin FValue := v; end; function TIn.AsString() : string; begin Result := FValue; end; function TIn.GetChild() : IIn; begin if FChild = nil then FChild := TIn.Create(); Writeln(FChild._AddRef - 1); FChild._Release; Result := FChild; end; // global var var test : RIn; // test procedure 1 procedure test1; begin test.GetChild().SetValue('test...'); end; // test procedure 2 procedure test2; begin Writeln( test.GetChild().AsString ); // <----- Error!! child interface is already released.. end; begin try test1; test2; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; readln; end. 

Conclusion (Delphi 2009) -

Bug2009

The same test on the outputs of Delphi XE

No bug Delphi XE

See different values โ€‹โ€‹of reference counters.

+7
source

Source: https://habr.com/ru/post/1496371/


All Articles