mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 06:49:16 +02:00
* apply patch by Blaise.ru: reject assignments of instance methods, accessed via a type, to method pointers
+ add tests
This commit is contained in:
parent
acee4eb27a
commit
a8cf67d73b
@ -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
29
tests/test/tprocvar10.pp
Normal 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
21
tests/test/tprocvar4.pp
Normal 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
21
tests/test/tprocvar5.pp
Normal 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
21
tests/test/tprocvar6.pp
Normal 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
26
tests/test/tprocvar7.pp
Normal 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
26
tests/test/tprocvar8.pp
Normal 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
24
tests/test/tprocvar9.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user