mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 22:07:56 +02:00
* fix for Mantis #31107: disallow calling of ordinary record methods using the record's type.
git-svn-id: trunk@35113 -
This commit is contained in:
parent
4e51dc2298
commit
22e579cc74
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -13772,6 +13772,7 @@ tests/webtbf/tw30022.pp svneol=native#text/plain
|
||||
tests/webtbf/tw3047.pp svneol=native#text/plain
|
||||
tests/webtbf/tw30494.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/tw3116.pp svneol=native#text/plain
|
||||
tests/webtbf/tw3126.pp svneol=native#text/plain
|
||||
|
@ -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);
|
||||
var
|
||||
isclassref:boolean;
|
||||
isrecordtype:boolean;
|
||||
begin
|
||||
if sym=nil then
|
||||
begin
|
||||
@ -1295,9 +1296,13 @@ implementation
|
||||
if not assigned(p1.resultdef) then
|
||||
do_typecheckpass(p1);
|
||||
isclassref:=(p1.resultdef.typ=classrefdef);
|
||||
isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
|
||||
end
|
||||
else
|
||||
isclassref:=false;
|
||||
begin
|
||||
isclassref:=false;
|
||||
isrecordtype:=false;
|
||||
end;
|
||||
|
||||
if assigned(spezcontext) and not (sym.typ=procsym) then
|
||||
internalerror(2015091801);
|
||||
@ -1313,7 +1318,13 @@ implementation
|
||||
{ we need to know which procedure is called }
|
||||
do_typecheckpass(p1);
|
||||
{ calling using classref? }
|
||||
if isclassref and
|
||||
if (
|
||||
isclassref or
|
||||
(
|
||||
isrecordtype and
|
||||
not (cnf_inherited in callflags)
|
||||
)
|
||||
) and
|
||||
(p1.nodetype=calln) and
|
||||
assigned(tcallnode(p1).procdefinition) then
|
||||
begin
|
||||
|
19
tests/webtbf/tw31107.pp
Normal file
19
tests/webtbf/tw31107.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user