paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 15:00:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* don't crash on empty ProcDefs when handling interfaces, resolves #11295

Browse Source 
git-svn-id: trunk@10978 -
This commit is contained in:
florian 2008-05-15 18:38:24 +00:00
parent d88a49be79
commit eca558b33b
4 changed files with 46 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -8206,6 +8206,8 @@ tests/webtbs/tw11254.pp svneol=native#text/plain
tests/webtbs/tw11255.pp svneol=native#text/plain
tests/webtbs/tw11288.pp svneol=native#text/plain
tests/webtbs/tw11290.pp svneol=native#text/plain
tests/webtbs/tw11295a.pp svneol=native#text/plain
tests/webtbs/tw11295b.pp svneol=native#text/plain
tests/webtbs/tw1132.pp svneol=native#text/plain
tests/webtbs/tw1133.pp svneol=native#text/plain
tests/webtbs/tw1152.pp svneol=native#text/plain

2
compiler/symdef.pas
View File

@ -4211,7 +4211,7 @@ implementation
begin
result:=false;
{ interfaces being implemented through delegation are not mergable (FK) }
if MergingIntf.IType<>etStandard then
if (MergingIntf.IType<>etStandard) or not(assigned(ProcDefs)) then
exit;
weight:=0;
{ empty interface is mergeable }

20
tests/webtbs/tw11295a.pp Normal file
View File

@ -0,0 +1,20 @@
program IntfDel;
{$ifdef fpc}
{$mode objfpc}
{$endif fpc}
uses
Classes;
type
IA = interface
end;
TA = class(TObject, IA, IUnknown)
private
FUnknown: IUnknown;
property Unknown: IUnknown read FUnknown implements IUnknown;
end;
begin
end.

23
tests/webtbs/tw11295b.pp Normal file
View File

@ -0,0 +1,23 @@
program IntfDel;
{$ifdef fpc}
{$mode objfpc}
{$endif fpc}
uses
Classes;
type
IA = interface
end;
IB = interface(IA)
end;
TA = class(TObject, IA, IB)
private
FA: IA;
property A: IA read FA implements IA;
end;
begin
end.