compiler: don't allow to execute instance methods, use instance fields and properties from the nested class (bug #0020721)

git-svn-id: trunk@19681 -
This commit is contained in:
paul 2011-11-25 08:33:24 +00:00
parent 8d2a7f3b88
commit 889196f1c8
5 changed files with 232 additions and 7 deletions

3
.gitattributes vendored
View File

@ -11005,6 +11005,9 @@ tests/webtbf/tw2053b.pp svneol=native#text/plain
tests/webtbf/tw20580.pp svneol=native#text/pascal
tests/webtbf/tw20661.pp svneol=native#text/plain
tests/webtbf/tw2070.pp svneol=native#text/plain
tests/webtbf/tw20721a.pp svneol=native#text/pascal
tests/webtbf/tw20721b.pp svneol=native#text/pascal
tests/webtbf/tw20721c.pp svneol=native#text/pascal
tests/webtbf/tw2128.pp svneol=native#text/plain
tests/webtbf/tw2129.pp svneol=native#text/plain
tests/webtbf/tw2154.pp svneol=native#text/plain

View File

@ -1184,7 +1184,7 @@ implementation
{ the ID token has to be consumed before calling this function }
procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags);
var
isclassref : boolean;
isclassref:boolean;
begin
if sym=nil then
begin
@ -1205,7 +1205,7 @@ implementation
isclassref:=(p1.resultdef.typ=classrefdef);
end
else
isclassref:=false;
isclassref:=false;
{ we assume, that only procsyms and varsyms are in an object }
{ symbol table, for classes, properties are allowed }
@ -1449,11 +1449,16 @@ implementation
p1:=nil;
if is_member_read(srsym,srsymtable,p1,hdef) then
begin
{ if the field was originally found in an }
{ objectsymtable, it means it's part of self
if only method from which it was called is
not class static }
{ if the field was originally found in an }
{ objectsymtable, it means it's part of self }
{ if only method from which it was called is }
{ not class static }
if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
{ if we are accessing a owner procsym from the nested }
{ class we need to call it as a class member }
if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
else
if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct))
else
@ -1620,6 +1625,11 @@ implementation
{ check if it's a method/class method }
if is_member_read(srsym,srsymtable,p1,hdef) then
begin
{ if we are accessing a owner procsym from the nested }
{ class we need to call it as a class member }
if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and
assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
p1:=cloadvmtaddrnode.create(ctypenode.create(hdef));
{ not srsymtable.symtabletype since that can be }
{ withsymtable as well }
if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
@ -1648,7 +1658,12 @@ implementation
if is_member_read(srsym,srsymtable,p1,hdef) then
begin
if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
{ if we are accessing a owner procsym from the nested }
{ class we need to call it as a class member }
if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
else
if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
{ no self node in static class methods }
p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
else

69
tests/webtbf/tw20721a.pp Normal file
View File

@ -0,0 +1,69 @@
{%norun}
{%fail}
program tw20721a;
{$mode delphi}
{$apptype console}
type
TFrame = class
type
TNested = class
procedure ProcN;
end;
var
fField: integer;
FNested: TNested;
procedure ProcF;
constructor Create;
destructor Destroy; override;
property Field: integer read fField write fField;
end;
var
Frame: TFrame;
procedure TFrame.TNested.ProcN;
begin
ProcF;
end;
procedure TFrame.ProcF;
begin
WriteLn(Self.ClassName);
WriteLn(NativeInt(Self));
WriteLn(fField);
end;
constructor TFrame.Create;
begin
inherited;
fField := 23;
FNested := TNested.Create;
end;
destructor TFrame.Destroy;
begin
FNested.Free;
end;
begin
Frame := TFrame.Create;
try
Frame.ProcF; { results:
TFrame
<address of Frame variable>
23
}
Frame.FNested.ProcN; { results:
TFrame.TNested
<address of field Frame.FNested>
<unpredictable: garbage or AV>
}
finally
Frame.Free
end;
end.

69
tests/webtbf/tw20721b.pp Normal file
View File

@ -0,0 +1,69 @@
{%norun}
{%fail}
program tw20721b;
{$mode delphi}
{$apptype console}
type
TFrame = class
type
TNested = class
procedure ProcN;
end;
var
fField: integer;
FNested: TNested;
procedure ProcF;
constructor Create;
destructor Destroy; override;
property Field: integer read fField write fField;
end;
var
Frame: TFrame;
procedure TFrame.TNested.ProcN;
begin
fField := 1;
end;
procedure TFrame.ProcF;
begin
WriteLn(Self.ClassName);
WriteLn(NativeInt(Self));
WriteLn(fField);
end;
constructor TFrame.Create;
begin
inherited;
fField := 23;
FNested := TNested.Create;
end;
destructor TFrame.Destroy;
begin
FNested.Free;
end;
begin
Frame := TFrame.Create;
try
Frame.ProcF; { results:
TFrame
<address of Frame variable>
23
}
Frame.FNested.ProcN; { results:
TFrame.TNested
<address of field Frame.FNested>
<unpredictable: garbage or AV>
}
finally
Frame.Free
end;
end.

69
tests/webtbf/tw20721c.pp Normal file
View File

@ -0,0 +1,69 @@
{%norun}
{%fail}
program tw20721c;
{$mode delphi}
{$apptype console}
type
TFrame = class
type
TNested = class
procedure ProcN;
end;
var
fField: integer;
FNested: TNested;
procedure ProcF;
constructor Create;
destructor Destroy; override;
property Field: integer read fField write fField;
end;
var
Frame: TFrame;
procedure TFrame.TNested.ProcN;
begin
Field := 1;
end;
procedure TFrame.ProcF;
begin
WriteLn(Self.ClassName);
WriteLn(NativeInt(Self));
WriteLn(fField);
end;
constructor TFrame.Create;
begin
inherited;
fField := 23;
FNested := TNested.Create;
end;
destructor TFrame.Destroy;
begin
FNested.Free;
end;
begin
Frame := TFrame.Create;
try
Frame.ProcF; { results:
TFrame
<address of Frame variable>
23
}
Frame.FNested.ProcN; { results:
TFrame.TNested
<address of field Frame.FNested>
<unpredictable: garbage or AV>
}
finally
Frame.Free
end;
end.