compiler: fix calling class methods from a nested routine of a static class method (mantis #0024865)

git-svn-id: trunk@25274 -

.gitattributes

@@ -13477,6 +13477,7 @@ tests/webtbs/tw2481.pp svneol=native#text/plain
 tests/webtbs/tw2483.pp svneol=native#text/plain
 tests/webtbs/tw24848.pp svneol=native#text/pascal
 tests/webtbs/tw24863.pp svneol=native#text/plain
+tests/webtbs/tw24865.pp svneol=native#text/pascal
 tests/webtbs/tw24871.pp svneol=native#text/pascal
 tests/webtbs/tw2492.pp svneol=native#text/plain
 tests/webtbs/tw2494.pp svneol=native#text/plain

compiler/pexpr.pas

@@ -907,6 +907,8 @@ implementation
 
 
     function maybe_load_methodpointer(st:TSymtable;var p1:tnode):boolean;
+      var
+        pd: tprocdef;
       begin
         maybe_load_methodpointer:=false;
         if not assigned(p1) then
@@ -920,12 +922,17 @@ implementation
              ObjectSymtable,
              recordsymtable:
                begin
+                 { Escape nested procedures }
+                 if assigned(current_procinfo) then
+                   pd:=current_procinfo.get_normal_proc.procdef
+                 else
+                   pd:=nil;
                  { We are calling from the static class method which has no self node }
-                 if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
+                 if assigned(pd) and pd.no_self_node then
                    if st.symtabletype=recordsymtable then
-                     p1:=ctypenode.create(current_procinfo.procdef.struct)
+                     p1:=ctypenode.create(pd.struct)
                    else
-                     p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct))
+                     p1:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
                  else
                    p1:=load_self_node;
                  { We are calling a member }
@@ -2789,20 +2796,13 @@ implementation
          end;
 
          function can_load_self_node: boolean;
-         var
-           procinfo: tprocinfo;
          begin
            result:=false;
            if (block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
               not assigned(current_structdef) or
               not assigned(current_procinfo) then
              exit;
-           procinfo:=current_procinfo;
-           if procinfo.procdef.parast.symtablelevel<normal_function_level then
-             exit;
-           while assigned(procinfo.parent)and(procinfo.procdef.parast.symtablelevel>normal_function_level) do
-             procinfo:=procinfo.parent;
-           result:=not procinfo.procdef.no_self_node;
+           result:=not current_procinfo.get_normal_proc.procdef.no_self_node;
          end;
 
       {---------------------------------------------

compiler/procinfo.pas

@@ -168,6 +168,7 @@ unit procinfo;
 
           function get_first_nestedproc: tprocinfo;
           function has_nestedprocs: boolean;
+          function get_normal_proc: tprocinfo;
 
           { Add to parent's list of nested procedures even if parent is a 'main' procedure }
           procedure force_nested;
@@ -271,6 +272,13 @@ implementation
         result:=assigned(nestedprocs) and (nestedprocs.count>0);
       end;
 
+    function tprocinfo.get_normal_proc: tprocinfo;
+      begin
+        result:=self;
+        while assigned(result.parent)and(result.procdef.parast.symtablelevel>normal_function_level) do
+          result:=result.parent;
+      end;
+
     procedure tprocinfo.save_jump_labels(out saved: tsavedlabels);
       begin
         saved[false]:=CurrFalseLabel;

tests/webtbs/tw24865.pp

@@ -0,0 +1,27 @@
+{ %NORUN }
+program tw24865;
+
+{$mode delphi}
+
+type
+  TTest = class
+    class procedure c1();
+    class procedure c2(); static;
+  end;
+
+class procedure TTest.c1;
+begin
+end;
+
+class procedure TTest.c2;
+  procedure nested;
+  begin
+    c1;
+  end;
+
+begin
+end;
+
+begin
+end.
+