mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 10:39:40 +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/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