* fix for Mantis #30830: also remove unregistered specializations from the procsym's deflist when they're removed to avoid an access to freed data

+ added tests (adjusted original test plus a mode Delphi variant)

git-svn-id: trunk@35012 -
This commit is contained in:
svenbarth 2016-11-29 14:12:02 +00:00
parent bfaa26d16a
commit ebfeb5b62a
4 changed files with 95 additions and 1 deletions

2
.gitattributes vendored
View File

@ -15263,6 +15263,8 @@ tests/webtbs/tw30706.pp svneol=native#text/plain
tests/webtbs/tw3073.pp svneol=native#text/plain
tests/webtbs/tw3082.pp svneol=native#text/plain
tests/webtbs/tw3083.pp svneol=native#text/plain
tests/webtbs/tw30830a.pp svneol=native#text/pascal
tests/webtbs/tw30830b.pp svneol=native#text/pascal
tests/webtbs/tw30831.pp svneol=native#text/pascal
tests/webtbs/tw30832.pp svneol=native#text/pascal
tests/webtbs/tw30889.pp svneol=native#text/pascal

View File

@ -2141,6 +2141,8 @@ implementation
var
hpnext,
hp : pcandidate;
psym : tprocsym;
i : longint;
begin
FIgnoredCandidateProcs.free;
hp:=FCandidateProcs;
@ -2149,7 +2151,19 @@ implementation
hpnext:=hp^.next;
{ free those procdef specializations that are not owned (thus were discarded) }
if hp^.data.is_specialization and not hp^.data.is_registered then
hp^.data.free;
begin
{ also remove the procdef from its symbol's procdeflist }
psym:=tprocsym(hp^.data.procsym);
for i:=0 to psym.procdeflist.count-1 do
begin
if psym.procdeflist[i]=hp^.data then
begin
psym.procdeflist.delete(i);
break;
end;
end;
hp^.data.free;
end;
dispose(hp);
hp:=hpnext;
end;

39
tests/webtbs/tw30830a.pp Normal file
View File

@ -0,0 +1,39 @@
{ %NORUN }
program tw30830a;
{$mode objfpc}
type
generic TBase<T> = class
procedure Test1(const a: T);
end;
generic TDerived<T> = class(specialize TBase<T>)
procedure Test2(const a: T);
end;
procedure TBase.Test1(const a: T);
begin
end;
procedure TDerived.Test2(const a: T);
begin
end;
generic procedure Test<T>(aIntf: specialize TBase<T>); // works
begin
end;
generic procedure Test<T>(aIntf: specialize TDerived<T>); // SIGSEGV :(
begin
end;
var
b: specialize TBase<LongInt>;
d: specialize TDerived<LongInt>;
begin
specialize Test<LongInt>(b);
specialize Test<LongInt>(d);
end.

39
tests/webtbs/tw30830b.pp Normal file
View File

@ -0,0 +1,39 @@
{ %NORUN }
program tw30830a;
{$mode delphi}
type
TBase<T> = class
procedure Test1(const a: T);
end;
TDerived<T> = class(TBase<T>)
procedure Test2(const a: T);
end;
procedure TBase<T>.Test1(const a: T);
begin
end;
procedure TDerived<T>.Test2(const a: T);
begin
end;
procedure Test<T>(aIntf: TBase<T>); overload; // works
begin
end;
procedure Test<T>(aIntf: TDerived<T>); overload; // SIGSEGV :(
begin
end;
var
b: TBase<LongInt>;
d: TDerived<LongInt>;
begin
Test<LongInt>(b);
Test<LongInt>(d);
end.