paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 12:23:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

* don't trash reference counted types with -gt (mantis 8183)

Browse Source 
git-svn-id: trunk@6149 -
This commit is contained in:
Jonas Maebe 2007-01-23 16:49:59 +00:00
parent 6db1d75fd8
commit fcb128c66c
3 changed files with 28 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7991,6 +7991,7 @@ tests/webtbs/tw8150a.pp svneol=native#text/plain
tests/webtbs/tw8150d.pp svneol=native#text/plain
tests/webtbs/tw8155.pp svneol=native#text/plain
tests/webtbs/tw8156.pp svneol=native#text/plain
tests/webtbs/tw8183.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

8
compiler/ncgutil.pas
View File

@ -963,9 +963,10 @@ implementation
trashintval: aint;
list: TAsmList absolute arg;
begin
if (tsym(p).typ=localvarsym) or
if ((tsym(p).typ=localvarsym) or
((tsym(p).typ=paravarsym) and
(vo_is_funcret in tparavarsym(p).varoptions)) then
(vo_is_funcret in tparavarsym(p).varoptions))) and
not(tabstractnormalvarsym(p).vardef.needs_inittable) then
begin
trashintval := trashintvalues[localvartrashing];
case tabstractnormalvarsym(p).initialloc.loc of
@ -1140,7 +1141,6 @@ implementation
if (tsym(p).typ=paravarsym) then
begin
needs_inittable :=
not is_class_or_interface(tparavarsym(p).vardef) and
tparavarsym(p).vardef.needs_inittable;
case tparavarsym(p).varspez of
vs_value :
@ -1158,6 +1158,7 @@ implementation
cg.a_load_loc_reg(list,OS_ADDR,tparavarsym(p).initialloc,tmpreg);
reference_reset_base(href,tmpreg,0);
if (localvartrashing <> -1) and
not(needs_inittable) and
{ needs separate implementation to trash open arrays }
{ since their size is only known at run time }
not is_special_array(tparavarsym(p).vardef) then
@ -1167,6 +1168,7 @@ implementation
end;
end;
else if (localvartrashing <> -1) and
not(needs_inittable) and
([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then
begin
tmpreg:=cg.getaddressregister(list);

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

@ -0,0 +1,21 @@
{ %opt=-gt }
program test;
{$MODE OBJFPC}
type
xstr = interface(iunknown) end;
operator := (a: integer): xstr;
begin
if ptruint(result) <> ptruint(nil) then
halt(1);
pointer(result) := nil;
end;
var
x: xstr;
begin
x := 42;
end.