* record a load node for the self/vmt tree of the current routine in the

tcallnode constructor, so that when it's needed later during pass 1,
    its value doesn't depend on the context in which pass 1 is executed
    (e.g. when inlining) (mantis #18121)

git-svn-id: trunk@30908 -

.gitattributes

@@ -13958,6 +13958,7 @@ tests/webtbs/tw18103a.pp svneol=native#text/pascal
 tests/webtbs/tw18103b.pp svneol=native#text/pascal
 tests/webtbs/tw18103c.pp svneol=native#text/pascal
 tests/webtbs/tw18113.pp svneol=native#text/plain
+tests/webtbs/tw18121.pp svneol=native#text/plain
 tests/webtbs/tw18123.pp svneol=native#text/pascal
 tests/webtbs/tw18127.pp svneol=native#text/pascal
 tests/webtbs/tw18131.pp svneol=native#text/pascal
@@ -15183,6 +15184,7 @@ tests/webtbs/uw17493.pp svneol=native#text/plain
 tests/webtbs/uw17950.pas svneol=native#text/pascal
 tests/webtbs/uw18087a.pp svneol=native#text/pascal
 tests/webtbs/uw18087b.pp svneol=native#text/pascal
+tests/webtbs/uw18121.pp svneol=native#text/plain
 tests/webtbs/uw18909a.pp svneol=native#text/pascal
 tests/webtbs/uw18909b.pp svneol=native#text/pascal
 tests/webtbs/uw19159.pp svneol=native#text/pascal

compiler/ncal.pas

@@ -121,6 +121,12 @@ interface
           procdefinitionderef : tderef;
           { tree that contains the pointer to the object for this method }
           methodpointer  : tnode;
+          { tree that contains the self/vmt parameter when this node was created
+            (so it's still valid when this node is processed in an inline
+             context)
+          }
+          call_self_node,
+          call_vmt_node: tnode;
           { initialize/finalization of temps }
           callinitblock,
           callcleanupblock : tblocknode;
@@ -1348,6 +1354,21 @@ implementation
          funcretnode:=nil;
          paralength:=-1;
          varargsparas:=nil;
+         if assigned(current_structdef) and
+            assigned(mp) then
+           begin
+             { can't determine now yet if it will be necessary or not, so
+               always create it if there is a 'self' symbol in the current
+               context }
+             if get_local_or_para_sym('self')<>nil then
+               call_self_node:=load_self_node;
+            { only needed when calling a destructor from an exception block in a
+              contructor of a TP-style object }
+            if is_object(current_structdef) and
+               (current_procinfo.procdef.proctypeoption=potype_constructor) and
+               (cnf_create_failed in callflags) then
+              call_vmt_node:=load_vmt_pointer_node;
+           end;
       end;
 
 
@@ -1470,6 +1491,8 @@ implementation
       begin
         callinitblock:=tblocknode(ppuloadnode(ppufile));
         methodpointer:=ppuloadnode(ppufile);
+        call_self_node:=ppuloadnode(ppufile);
+        call_vmt_node:=ppuloadnode(ppufile);
         callcleanupblock:=tblocknode(ppuloadnode(ppufile));
         funcretnode:=ppuloadnode(ppufile);
         inherited ppuload(t,ppufile);
@@ -1485,6 +1508,8 @@ implementation
       begin
         ppuwritenode(ppufile,callinitblock);
         ppuwritenode(ppufile,methodpointer);
+        ppuwritenode(ppufile,call_self_node);
+        ppuwritenode(ppufile,call_vmt_node);
         ppuwritenode(ppufile,callcleanupblock);
         ppuwritenode(ppufile,funcretnode);
         inherited ppuwrite(ppufile);
@@ -1501,6 +1526,10 @@ implementation
         procdefinitionderef.build(procdefinition);
         if assigned(methodpointer) then
           methodpointer.buildderefimpl;
+        if assigned(call_self_node) then
+          call_self_node.buildderefimpl;
+        if assigned(call_vmt_node) then
+          call_vmt_node.buildderefimpl;
         if assigned(callinitblock) then
           callinitblock.buildderefimpl;
         if assigned(callcleanupblock) then
@@ -1522,6 +1551,10 @@ implementation
         procdefinition:=tabstractprocdef(procdefinitionderef.resolve);
         if assigned(methodpointer) then
           methodpointer.derefimpl;
+        if assigned(call_self_node) then
+          call_self_node.derefimpl;
+        if assigned(call_vmt_node) then
+          call_vmt_node.derefimpl;
         if assigned(callinitblock) then
           callinitblock.derefimpl;
         if assigned(callcleanupblock) then
@@ -1583,6 +1616,14 @@ implementation
           n.methodpointer:=methodpointer.dogetcopy
         else
           n.methodpointer:=nil;
+        if assigned(call_self_node) then
+          n.call_self_node:=call_self_node.dogetcopy
+        else
+          n.call_self_node:=nil;
+        if assigned(call_vmt_node) then
+          n.call_vmt_node:=call_vmt_node.dogetcopy
+        else
+          n.call_vmt_node:=nil;
         { must be copied before the funcretnode, because the callcleanup block
           may contain a ttempdeletenode that sets the tempinfo of the
           corresponding temp to ti_nextref_set_hookoncopy_nil, and this nextref
@@ -2033,7 +2074,7 @@ implementation
         { inherited }
         else if (cnf_inherited in callnodeflags) then
           begin
-            selftree:=load_self_node;
+            selftree:=call_self_node;
            { we can call an inherited class static/method from a regular method
              -> self node must change from instance pointer to vmt pointer)
            }
@@ -2089,7 +2130,7 @@ implementation
                           end;
                       end
                     else
-                      selftree:=load_self_node
+                      selftree:=call_self_node
                   else
                     selftree:=methodpointer.getcopy;
                 end;
@@ -2126,7 +2167,7 @@ implementation
         else
           begin
             if methodpointer.nodetype=typen then
-              selftree:=load_self_node
+              selftree:=call_self_node
             else
               selftree:=methodpointer.getcopy;
           end;
@@ -2369,7 +2410,7 @@ implementation
              temp:=ctempcreatenode.create(objcsupertype,objcsupertype.size,tt_persistent,false);
              addstatement(statements,temp);
              { initialize objc_super record }
-             selftree:=load_self_node;
+             selftree:=call_self_node;
 
              { we can call an inherited class static/method from a regular method
                -> self node must change from instance pointer to vmt pointer)
@@ -2539,7 +2580,7 @@ implementation
             else
               { destructor called from exception block in constructor }
               if (cnf_create_failed in callnodeflags) then
-                vmttree:=ctypeconvnode.create_internal(load_vmt_pointer_node,voidpointertype)
+                vmttree:=ctypeconvnode.create_internal(call_vmt_node,voidpointertype)
             else
               { inherited call, no create/destroy }
               if (cnf_inherited in callnodeflags) then
@@ -3563,6 +3604,11 @@ implementation
                parameters:=nil;
              end;
 
+         if assigned(call_self_node) then
+           typecheckpass(call_self_node);
+         if assigned(call_vmt_node) then
+           typecheckpass(call_vmt_node);
+
          finally
            aktcallnode:=oldcallnode;
          end;

compiler/nutils.pas

@@ -68,6 +68,7 @@ interface
     procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
 
     procedure load_procvar_from_calln(var p1:tnode);
+    function get_local_or_para_sym(const aname: string): tsym;
     function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
     function load_high_value_node(vs:tparavarsym):tnode;
     function load_self_node:tnode;
@@ -425,7 +426,7 @@ implementation
       end;
 
 
-    function get_local_or_para_sym(const aname:string):tsym;
+    function get_local_or_para_sym(const aname: string): tsym;
       var
         pd : tprocdef;
       begin

tests/webtbs/tw18121.pp

@@ -0,0 +1,17 @@
+{ %recompile }
+
+{$mode objfpc}
+
+{$inline on}
+
+uses
+  uw18121;
+
+var
+  IntO: TPointerList2;
+begin
+  IntO := TPointerList2.Create;
+  IntO.SetF(PInteger(nil));
+  IntO.WriteLn;
+  IntO.Free;
+end.

tests/webtbs/uw18121.pp

@@ -0,0 +1,55 @@
+unit uw18121;
+{$inline on}
+
+interface 
+
+{$mode objfpc}{$H+}
+uses
+  SysUtils;
+
+type
+  { T1 }
+
+  TPointerList = class
+  private
+    i: Pointer;
+    procedure SetF(v: Pointer);
+    function GetF: Pointer;
+  end;
+
+  { TPointerList2 }
+
+  TPointerList2 = class(TPointerList)
+  public
+    procedure SetF(v: PInteger); inline;
+    procedure WriteLn;
+  end;
+
+implementation
+
+  procedure TPointerList.SetF(v: Pointer);
+  begin
+    i := v;
+  end;
+
+  function TPointerList.GetF: Pointer;
+  begin
+    Result := i;
+  end;
+
+  { TPointerList2 }
+
+  procedure TPointerList2.SetF(v: PInteger); inline;
+  begin
+    inherited SetF(Pointer(v));
+  end;
+
+  procedure TPointerList2.WriteLn;
+  var
+    S: string;
+  begin
+    S := Format('%P', [i]);
+    System.WriteLn(S);
+  end;
+
+end.