paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 10:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for Mantis #31107: disallow calling of ordinary record methods using the record's type.

Browse Source 
git-svn-id: trunk@35113 -
This commit is contained in:
svenbarth 2016-12-12 22:08:28 +00:00
parent 4e51dc2298
commit 22e579cc74
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

@ -13772,6 +13772,7 @@ tests/webtbf/tw30022.pp svneol=native#text/plain
tests/webtbf/tw3047.pp svneol=native#text/plain tests/webtbf/tw3047.pp svneol=native#text/plain
tests/webtbf/tw30494.pp svneol=native#text/pascal tests/webtbf/tw30494.pp svneol=native#text/pascal
tests/webtbf/tw31016.pp svneol=native#text/pascal tests/webtbf/tw31016.pp svneol=native#text/pascal
tests/webtbf/tw31107.pp svneol=native#text/pascal
tests/webtbf/tw3114.pp svneol=native#text/plain tests/webtbf/tw3114.pp svneol=native#text/plain
tests/webtbf/tw3116.pp svneol=native#text/plain tests/webtbf/tw3116.pp svneol=native#text/plain
tests/webtbf/tw3126.pp svneol=native#text/plain tests/webtbf/tw3126.pp svneol=native#text/plain

15
compiler/pexpr.pas
View File

@ -1276,6 +1276,7 @@ implementation
procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext); procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
var var
isclassref:boolean; isclassref:boolean;
isrecordtype:boolean;
begin begin
if sym=nil then if sym=nil then
begin begin
@ -1295,9 +1296,13 @@ implementation
if not assigned(p1.resultdef) then if not assigned(p1.resultdef) then
do_typecheckpass(p1); do_typecheckpass(p1);
isclassref:=(p1.resultdef.typ=classrefdef); isclassref:=(p1.resultdef.typ=classrefdef);
isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
end end
else else
isclassref:=false; begin
isclassref:=false;
isrecordtype:=false;
end;
if assigned(spezcontext) and not (sym.typ=procsym) then if assigned(spezcontext) and not (sym.typ=procsym) then
internalerror(2015091801); internalerror(2015091801);
@ -1313,7 +1318,13 @@ implementation
{ we need to know which procedure is called } { we need to know which procedure is called }
do_typecheckpass(p1); do_typecheckpass(p1);
{ calling using classref? } { calling using classref? }
if isclassref and if (
isclassref or
(
isrecordtype and
not (cnf_inherited in callflags)
)
) and
(p1.nodetype=calln) and (p1.nodetype=calln) and
assigned(tcallnode(p1).procdefinition) then assigned(tcallnode(p1).procdefinition) then
begin begin

19
tests/webtbf/tw31107.pp Normal file
View File

@ -0,0 +1,19 @@
{ %FAIL }
program tw31107;
{$MODE DELPHI}
uses RTTI;
type
TFoo = class
private
FBar: string;
public
property Bar: string read FBar;
end;
begin
Writeln(Assigned(TRttiContext.GetType(TFoo).GetProperty('Bar')));
end.