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

* treat methods called via records the same as records called via objects

Browse Source 
without virtual methods: they may initialise the instance (mantis #23667)

git-svn-id: trunk@23976 -
This commit is contained in:
Jonas Maebe 2013-03-24 16:27:02 +00:00
parent 79d5d83f6c
commit 1601f6bea8
3 changed files with 33 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -13275,6 +13275,7 @@ tests/webtbs/tw23503.pp svneol=native#text/pascal
tests/webtbs/tw2351.pp svneol=native#text/plain tests/webtbs/tw2351.pp svneol=native#text/plain
tests/webtbs/tw23568.pp -text svneol=native#text/plain tests/webtbs/tw23568.pp -text svneol=native#text/plain
tests/webtbs/tw2363.pp svneol=native#text/plain tests/webtbs/tw2363.pp svneol=native#text/plain
tests/webtbs/tw23667.pp svneol=native#text/plain
tests/webtbs/tw23725.pp svneol=native#text/pascal tests/webtbs/tw23725.pp svneol=native#text/pascal
tests/webtbs/tw23744.pp svneol=native#text/plain tests/webtbs/tw23744.pp svneol=native#text/plain
tests/webtbs/tw2377.pp svneol=native#text/plain tests/webtbs/tw2377.pp svneol=native#text/plain

8
compiler/ncal.pas
View File

@ -3150,6 +3150,8 @@ implementation
hpt:=methodpointer; hpt:=methodpointer;
while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
hpt:=tunarynode(hpt).left; hpt:=tunarynode(hpt).left;
{ skip (absolute and other simple) type conversions }
hpt:=hpt.actualtargetnode;
if ((hpt.nodetype=loadvmtaddrn) or if ((hpt.nodetype=loadvmtaddrn) or
((hpt.nodetype=loadn) and assigned(tloadnode(hpt).resultdef) and (tloadnode(hpt).resultdef.typ=classrefdef))) and ((hpt.nodetype=loadn) and assigned(tloadnode(hpt).resultdef) and (tloadnode(hpt).resultdef.typ=classrefdef))) and
@ -3169,8 +3171,10 @@ implementation
Also allow it for simple loads } Also allow it for simple loads }
if (procdefinition.proctypeoption=potype_constructor) or if (procdefinition.proctypeoption=potype_constructor) or
((hpt.nodetype=loadn) and ((hpt.nodetype=loadn) and
(methodpointer.resultdef.typ=objectdef) and (((methodpointer.resultdef.typ=objectdef) and
not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions) not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions)) or
(methodpointer.resultdef.typ=recorddef)
)
) then ) then
{ a constructor will and a method may write something to } { a constructor will and a method may write something to }
{ the fields } { the fields }

26
tests/webtbs/tw23667.pp Normal file
View File

@ -0,0 +1,26 @@
{ %opt=-vw -Sew }
{ %norun }
{$mode objfpc}
{$modeswitch advancedrecords}
type
tpoint = record
x,y: longint;
function add(const aPoint:Tpoint):TPoint;
procedure setlocation(xx,yy: longint);
end;
procedure tpoint.setlocation(xx,yy: longint);
begin
x:=xx;
y:=yy;
end;
function TPoint.Add(const aPoint:Tpoint):TPoint;
begin
Result.SetLocation(self.x+aPoint.X, self.Y+aPoint.Y);
end;
begin
end.