mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-09 01:29:32 +01:00
compiler: don't treat methods without self node (static class methods, class contructors, destructors, operators) as method pointers, fix comparison of procdef and procvardef to allow assignment of a static class method to a regular procedural variable (issue #24486)
git-svn-id: trunk@25284 -
This commit is contained in:
parent
a2a405581c
commit
17ef986b17
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -13466,6 +13466,7 @@ tests/webtbs/tw2432.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw2435.pp svneol=native#text/plain
|
tests/webtbs/tw2435.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2438.pp svneol=native#text/plain
|
tests/webtbs/tw2438.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2442.pp svneol=native#text/plain
|
tests/webtbs/tw2442.pp svneol=native#text/plain
|
||||||
|
tests/webtbs/tw24486.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw2452.pp svneol=native#text/plain
|
tests/webtbs/tw2452.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw24536.pp svneol=native#text/plain
|
tests/webtbs/tw24536.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2454.pp svneol=native#text/plain
|
tests/webtbs/tw2454.pp svneol=native#text/plain
|
||||||
|
|||||||
@ -2148,8 +2148,10 @@ implementation
|
|||||||
if checkincompatibleuniv then
|
if checkincompatibleuniv then
|
||||||
include(pa_comp,cpo_warn_incompatible_univ);
|
include(pa_comp,cpo_warn_incompatible_univ);
|
||||||
{ check return value and options, methodpointer is already checked }
|
{ check return value and options, methodpointer is already checked }
|
||||||
po_comp:=[po_staticmethod,po_interrupt,
|
po_comp:=[po_interrupt,po_iocheck,po_varargs];
|
||||||
po_iocheck,po_varargs];
|
{ check static only if we compare method pointers }
|
||||||
|
if def1.is_methodpointer then
|
||||||
|
include(po_comp,po_staticmethod);
|
||||||
if (m_delphi in current_settings.modeswitches) then
|
if (m_delphi in current_settings.modeswitches) then
|
||||||
exclude(po_comp,po_varargs);
|
exclude(po_comp,po_varargs);
|
||||||
if (def1.proccalloption=def2.proccalloption) and
|
if (def1.proccalloption=def2.proccalloption) and
|
||||||
|
|||||||
@ -4769,14 +4769,14 @@ implementation
|
|||||||
begin
|
begin
|
||||||
{ don't check assigned(_class), that's also the case for nested
|
{ don't check assigned(_class), that's also the case for nested
|
||||||
procedures inside methods }
|
procedures inside methods }
|
||||||
result:=owner.symtabletype=ObjectSymtable;
|
result:=(owner.symtabletype=ObjectSymtable)and not no_self_node;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function tprocdef.is_addressonly:boolean;
|
function tprocdef.is_addressonly:boolean;
|
||||||
begin
|
begin
|
||||||
result:=assigned(owner) and
|
result:=assigned(owner) and
|
||||||
(owner.symtabletype<>ObjectSymtable) and
|
not is_methodpointer and
|
||||||
(not(m_nested_procvars in current_settings.modeswitches) or
|
(not(m_nested_procvars in current_settings.modeswitches) or
|
||||||
not is_nested_pd(self));
|
not is_nested_pd(self));
|
||||||
end;
|
end;
|
||||||
|
|||||||
25
tests/webtbs/tw24486.pp
Normal file
25
tests/webtbs/tw24486.pp
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
{%NORUN}
|
||||||
|
program tw24486;
|
||||||
|
|
||||||
|
{$mode delphi}
|
||||||
|
|
||||||
|
type
|
||||||
|
tproc1 = procedure(a: integer);
|
||||||
|
|
||||||
|
var
|
||||||
|
proc1: tproc1;
|
||||||
|
|
||||||
|
type
|
||||||
|
tclass1 = class
|
||||||
|
class procedure p1(a: integer); static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ tclass1 }
|
||||||
|
|
||||||
|
class procedure tclass1.p1(a: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
proc1 := tclass1.p1;
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue
Block a user