* call FreeInstance after fail if vmt<>nil rather than if vmt=1

(mantis #10790)

git-svn-id: trunk@10249 -
This commit is contained in:
Jonas Maebe 2008-02-08 15:04:58 +00:00
parent 521b5d88ff
commit c44fb4a79e
3 changed files with 30 additions and 6 deletions

1
.gitattributes vendored
View File

@ -7965,6 +7965,7 @@ tests/webtbs/tw10736.pp svneol=native#text/plain
tests/webtbs/tw10753.pp svneol=native#text/plain
tests/webtbs/tw10753a.pp svneol=native#text/plain
tests/webtbs/tw10757.pp svneol=native#text/plain
tests/webtbs/tw10790.pp svneol=native#text/plain
tests/webtbs/tw1081.pp svneol=native#text/plain
tests/webtbs/tw1090.pp svneol=native#text/plain
tests/webtbs/tw1092.pp svneol=native#text/plain

View File

@ -471,17 +471,15 @@ implementation
if assigned(srsym) and
(srsym.typ=procsym) then
begin
{ if self<>0 and vmt=1 then freeinstance }
{ if self<>0 and vmt<>0 then freeinstance }
addstatement(newstatement,cifnode.create(
caddnode.create(andn,
caddnode.create(unequaln,
load_self_pointer_node,
cnilnode.create),
caddnode.create(equaln,
ctypeconvnode.create(
load_vmt_pointer_node,
voidpointertype),
cpointerconstnode.create(1,voidpointertype))),
caddnode.create(unequaln,
load_vmt_pointer_node,
cnilnode.create)),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
nil));
end

25
tests/webtbs/tw10790.pp Normal file
View File

@ -0,0 +1,25 @@
{ %OPT=-gh }
{$ifdef fpc}
{$mode delphi}
{$endif}
program failtest;
type
TMyClass = class
constructor Create;
end;
constructor TMyClass.Create;
begin
Fail;
end;
var
MyClass : TMyClass;
begin
HaltOnNotReleased := true;
MyClass := TMyClass.Create;
end.