paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 10:58:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

WPO: don't crash on TP-style objects with only abstract virtual methods

Browse Source
This commit is contained in:
Jonas Maebe 2025-01-01 15:23:06 +01:00
parent 2a6fb32974
commit 540807c5c8
2 changed files with 25 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
compiler/optvirt.pas
View File

@ -706,7 +706,10 @@ unit optvirt;
defunitclassname(node.def,unitid,classid,classprefix); defunitclassname(node.def,unitid,classid,classprefix);
unitdevirtinfo:=addunitifnew(unitid^); unitdevirtinfo:=addunitifnew(unitid^);
classdevirtinfo:=unitdevirtinfo.addclass(classprefix+classid^,node.instantiated); classdevirtinfo:=unitdevirtinfo.addclass(classprefix+classid^,node.instantiated);
if (node.def.vmtentries.count=0) then { node.def.vmcallstaticinfo can be nil if the object only has abstract
virtual methods }
if (node.def.vmtentries.count=0) or
not assigned(node.def.vmcallstaticinfo) then
exit; exit;
for i:=0 to node.def.vmtentries.count-1 do for i:=0 to node.def.vmtentries.count-1 do
if (po_virtualmethod in pvmtentry(node.def.vmtentries[i])^.procdef.procoptions) then if (po_virtualmethod in pvmtentry(node.def.vmtentries[i])^.procdef.procoptions) then

21
tests/webtbs/tw41077.pp Normal file
View File

@ -0,0 +1,21 @@
{ %wpoparas=optvmts }
{ %wpopasses=1 }
program test;
type
PMyObj=^TMyObj;
TMyObj = object
constructor init;
procedure dummy;virtual;abstract;
end;
constructor TMyObj.init;
begin
end;
begin
PMyObj(nil)^.init;
end.