mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-01 10:42:34 +02:00
* 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:
parent
bfaa26d16a
commit
ebfeb5b62a
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
@ -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
39
tests/webtbs/tw30830a.pp
Normal 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
39
tests/webtbs/tw30830b.pp
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user