* reduce redundant temporary interfaces variables, resolves #14092

git-svn-id: trunk@15880 -

.gitattributes

@@ -10475,6 +10475,7 @@ tests/webtbs/tw14067.pp svneol=native#text/plain
 tests/webtbs/tw1407.pp svneol=native#text/plain
 tests/webtbs/tw1408.pp svneol=native#text/plain
 tests/webtbs/tw1409.pp svneol=native#text/plain
+tests/webtbs/tw14092.pp svneol=native#text/pascal
 tests/webtbs/tw1412.pp svneol=native#text/plain
 tests/webtbs/tw14124.pp svneol=native#text/plain
 tests/webtbs/tw14134.pp svneol=native#text/plain

compiler/ncal.pas

@@ -1360,6 +1360,17 @@ implementation
           end;
       end;
 
+    function look_for_call(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        case n.nodetype of
+          calln:
+            result := fen_norecurse_true;
+          typen,loadvmtaddrn,loadn,temprefn,arrayconstructorn:
+            result := fen_norecurse_false;
+        else
+          result := fen_false;
+        end;
+      end;
 
     procedure tcallnode.maybe_load_in_temp(var p:tnode);
       var
@@ -1372,7 +1383,7 @@ implementation
         { Load all complex loads into a temp to prevent
           double calls to a function. We can't simply check for a hp.nodetype=calln }
         if assigned(p) and
-           not is_simple_para_load(p,true) then
+           foreachnodestatic(p,@look_for_call,nil) then
           begin
             { temp create }
             usederef:=(p.resultdef.typ in [arraydef,recorddef]) or

compiler/nld.pas

@@ -695,6 +695,9 @@ implementation
               if (right.nodetype<>stringconstn) or
                  (tstringconstnode(right).len<>0) then
                begin
+                 { remove property flag to avoid errors, see comments for }
+                 { tf_winlikewidestring assignments below                 }
+                 exclude(left.flags, nf_isproperty);
                  hp:=ccallparanode.create
                        (right,
                   ccallparanode.create(left,nil));

tests/webtbs/tw14092.pp

@@ -0,0 +1,58 @@
+program FPTest;
+{$mode delphi}
+
+type
+  iintf = interface(IUnknown)
+    function GetIntf :iintf;
+    procedure DoSomething;
+  end; 
+
+  tobj = class(TObject)
+    fintf: iintf;
+    procedure test1;
+    procedure test2;
+  end;
+
+  tintf = class(TInterfacedObject,iintf)
+    function GetIntf : iintf;
+    procedure DoSomething;
+  end;
+
+procedure tobj.test1;
+begin
+  fintf.DoSomething;
+end;
+
+procedure tobj.test2;
+begin
+  fintf.GetIntf.GetIntf.DoSomething;
+end;
+
+
+function tintf.GetIntf : iintf;
+  begin
+    result:=self;
+  end;
+  
+var
+  refs : Integer;
+  
+procedure tintf.DoSomething;
+  begin
+    if RefCount<>refs then
+      halt(1);
+    writeln(RefCount);
+  end;
+
+var
+  obj : tobj;
+begin
+  obj:=tobj.create;
+  obj.fintf:=tintf.create;
+  refs:=1;
+  obj.test1;
+  refs:=3;
+  obj.test2;
+  obj.free;
+  writeln('ok');
+end.