* apply patch by Blaise.ru: reject assignments of instance methods, accessed via a type, to method pointers

+ add tests
This commit is contained in:
Sven/Sarah Barth 2022-01-06 21:33:57 +01:00
parent acee4eb27a
commit a8cf67d73b
8 changed files with 186 additions and 1 deletions

View File

@ -1361,8 +1361,25 @@ implementation
again,p1,callflags,spezcontext);
{ we need to know which procedure is called }
do_typecheckpass(p1);
{ We are loading... }
if p1.nodetype=loadn then
begin
{ an instance method }
if not (po_classmethod in tloadnode(p1).procdef.procoptions) and
{ into a method pointer (not just taking a code address) }
not getaddr and
{ and the selfarg is... }
(
{ either a record/object/helper type, }
not assigned(tloadnode(p1).left) or
{ or a class/metaclass type, or a class reference }
(tloadnode(p1).left.resultdef.typ=classrefdef)
) then
Message(parser_e_only_class_members_via_class_ref);
end
{ calling using classref? }
if (
else if (
isclassref or
(
(isobjecttype or

29
tests/test/tprocvar10.pp Normal file
View File

@ -0,0 +1,29 @@
{ %FAIL }
program tprocvar10;
{$mode delphi}
var
Z: procedure of object;
type
C = class
end;
H = class helper for C
procedure Foo;
class procedure ClassCtx;
end;
procedure H.Foo;
begin
end;
class procedure H.ClassCtx;
begin
Z := Foo;
end;
begin
end.

21
tests/test/tprocvar4.pp Normal file
View File

@ -0,0 +1,21 @@
{ %FAIL }
program tprocvar4;
{$mode delphi}
var
Z: procedure of object;
type
R = record
procedure Foo;
end;
procedure R.Foo;
begin
end;
begin
Z := R.Foo;
end.

21
tests/test/tprocvar5.pp Normal file
View File

@ -0,0 +1,21 @@
{ %FAIL }
program tprocvar5;
{$mode delphi}
var
Z: procedure of object;
type
O = object
procedure Foo;
end;
procedure O.Foo;
begin
end;
begin
Z := O.Foo;
end.

21
tests/test/tprocvar6.pp Normal file
View File

@ -0,0 +1,21 @@
{ %FAIL }
program tprocvar6;
{$mode delphi}
var
Z: procedure of object;
type
C = class
procedure Foo;
end;
procedure C.Foo;
begin
end;
begin
Z := C.Foo;
end.

26
tests/test/tprocvar7.pp Normal file
View File

@ -0,0 +1,26 @@
{ %FAIL }
program tprocvar7;
{$mode delphi}
var
Z: procedure of object;
type
C = class
procedure Foo;
class procedure ClassCtx;
end;
procedure C.Foo;
begin
end;
class procedure C.ClassCtx;
begin
Z := Foo;
end;
begin
end.

26
tests/test/tprocvar8.pp Normal file
View File

@ -0,0 +1,26 @@
{ %FAIL }
program tprocvar8;
{$mode delphi}
var
Z: procedure of object;
type
C = class
procedure Foo;
end;
CC = class of C;
procedure C.Foo;
begin
end;
var
aCC: CC = Nil;
begin
Z := aCC.Foo;
end.

24
tests/test/tprocvar9.pp Normal file
View File

@ -0,0 +1,24 @@
{ %FAIL }
program tprocvar9;
{$mode delphi}
var
Z: procedure of object;
type
C = class
end;
H = class helper for C
procedure Foo;
end;
procedure H.Foo;
begin
end;
begin
Z := H.Foo;
end.