mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 05:49:20 +02: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/tw2438.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/tw24536.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2454.pp svneol=native#text/plain
|
||||
|
@ -2113,8 +2113,8 @@ implementation
|
||||
|
||||
function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;checkincompatibleuniv: boolean):tequaltype;
|
||||
var
|
||||
eq : tequaltype;
|
||||
po_comp : tprocoptions;
|
||||
eq: tequaltype;
|
||||
po_comp: tprocoptions;
|
||||
pa_comp: tcompare_paras_options;
|
||||
begin
|
||||
proc_to_procvar_equal:=te_incompatible;
|
||||
@ -2148,8 +2148,10 @@ implementation
|
||||
if checkincompatibleuniv then
|
||||
include(pa_comp,cpo_warn_incompatible_univ);
|
||||
{ check return value and options, methodpointer is already checked }
|
||||
po_comp:=[po_staticmethod,po_interrupt,
|
||||
po_iocheck,po_varargs];
|
||||
po_comp:=[po_interrupt,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
|
||||
exclude(po_comp,po_varargs);
|
||||
if (def1.proccalloption=def2.proccalloption) and
|
||||
|
@ -4769,14 +4769,14 @@ implementation
|
||||
begin
|
||||
{ don't check assigned(_class), that's also the case for nested
|
||||
procedures inside methods }
|
||||
result:=owner.symtabletype=ObjectSymtable;
|
||||
result:=(owner.symtabletype=ObjectSymtable)and not no_self_node;
|
||||
end;
|
||||
|
||||
|
||||
function tprocdef.is_addressonly:boolean;
|
||||
begin
|
||||
result:=assigned(owner) and
|
||||
(owner.symtabletype<>ObjectSymtable) and
|
||||
not is_methodpointer and
|
||||
(not(m_nested_procvars in current_settings.modeswitches) or
|
||||
not is_nested_pd(self));
|
||||
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