mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-02 22:27:21 +01:00
* fixed assigning an interface to a property after better property
checks git-svn-id: trunk@7484 -
This commit is contained in:
parent
17bc78aa65
commit
fa5e232055
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -6855,6 +6855,7 @@ tests/test/tinterface1.pp svneol=native#text/plain
|
||||
tests/test/tinterface2.pp svneol=native#text/plain
|
||||
tests/test/tinterface3.pp svneol=native#text/plain
|
||||
tests/test/tinterface4.pp svneol=native#text/plain
|
||||
tests/test/tinterface5.pp svneol=native#text/plain
|
||||
tests/test/tinterrupt.pp svneol=native#text/plain
|
||||
tests/test/tintfdef.pp svneol=native#text/plain
|
||||
tests/test/tintuint.pp svneol=native#text/plain
|
||||
|
||||
@ -649,6 +649,9 @@ implementation
|
||||
{ call helpers for interface }
|
||||
if is_interfacecom(left.resultdef) then
|
||||
begin
|
||||
{ remove property flag to avoid errors, see comments for }
|
||||
{ tf_winlikewidestring assignments below }
|
||||
exclude(left.flags,nf_isproperty);
|
||||
if right.resultdef.is_related(left.resultdef) then
|
||||
begin
|
||||
hp:=
|
||||
|
||||
57
tests/test/tinterface5.pp
Normal file
57
tests/test/tinterface5.pp
Normal file
@ -0,0 +1,57 @@
|
||||
{ %VERSION=1.1 }
|
||||
{ %SKIPTARGET=macos }
|
||||
{ On macos it crashes when run.}
|
||||
|
||||
{$mode objfpc}
|
||||
type
|
||||
IInterface = interface(IUnknown)
|
||||
procedure mydo;
|
||||
end;
|
||||
|
||||
TMyClass = class(TInterfacedObject, IInterface)
|
||||
procedure mydo;virtual;
|
||||
end;
|
||||
|
||||
TMyClass2 = class(TMyClass)
|
||||
i : integer;
|
||||
end;
|
||||
|
||||
TMyClass3 = class
|
||||
private
|
||||
fi: IInterface;
|
||||
public
|
||||
property intf: IInterface read fi write fi;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
var
|
||||
l : longint;
|
||||
|
||||
procedure tmyclass.mydo;
|
||||
|
||||
begin
|
||||
l:=1;
|
||||
end;
|
||||
|
||||
var
|
||||
c: TMyClass;
|
||||
c2 : TMyClass;
|
||||
c3 : TMyClass3;
|
||||
|
||||
begin
|
||||
c := TMyClass.Create;
|
||||
c3 := TMyClass3.Create;
|
||||
c3.intf := c;
|
||||
l:=0;
|
||||
c3.intf.mydo;
|
||||
if l<>1 then
|
||||
halt(1);
|
||||
c2 := TMyClass2.Create;
|
||||
c3.intf := c2;
|
||||
l:=0;
|
||||
c3.intf.mydo;
|
||||
if l<>1 then
|
||||
halt(1);
|
||||
c3.free;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user