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:
paul 2013-08-18 17:29:23 +00:00
parent a2a405581c
commit 17ef986b17
4 changed files with 34 additions and 6 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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

View File

@ -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
View 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.