Sfoglia il codice sorgente

* don't do tail recursion optimization on method calls having an explicit self pointer, resolves #17402

git-svn-id: trunk@15997 -
florian 15 anni fa
parent
commit
b147f5b716
4 ha cambiato i file con 67 aggiunte e 1 eliminazioni
  1. 2 0
      .gitattributes
  2. 1 1
      compiler/opttail.pas
  3. 46 0
      tests/webtbs/tw17402.pp
  4. 18 0
      tests/webtbs/tw17402a.pp

+ 2 - 0
.gitattributes

@@ -10656,6 +10656,8 @@ tests/webtbs/tw1735.pp svneol=native#text/plain
 tests/webtbs/tw1737.pp svneol=native#text/plain
 tests/webtbs/tw17379.pp svneol=native#text/plain
 tests/webtbs/tw17379a.pp svneol=native#text/plain
+tests/webtbs/tw17402.pp svneol=native#text/pascal
+tests/webtbs/tw17402a.pp svneol=native#text/pascal
 tests/webtbs/tw17413.pp svneol=native#text/plain
 tests/webtbs/tw1744.pp svneol=native#text/plain
 tests/webtbs/tw1754c.pp svneol=native#text/plain

+ 1 - 1
compiler/opttail.pas

@@ -52,7 +52,7 @@ unit opttail;
 
         function is_recursivecall(n : tnode) : boolean;
           begin
-            result:=(n.nodetype=calln) and (tcallnode(n).procdefinition=p);
+            result:=(n.nodetype=calln) and (tcallnode(n).procdefinition=p) and not(assigned(tcallnode(n).methodpointer));
             if result then
               usedcallnode:=tcallnode(n)
             else

+ 46 - 0
tests/webtbs/tw17402.pp

@@ -0,0 +1,46 @@
+{$mode objfpc}
+{$H+}
+
+uses SysUtils;
+
+type
+  TVRMLGeometryNode = class
+  public
+    function TrianglesCount(ProxyGeometry: TVRMLGeometryNode): Cardinal; virtual;
+  end;
+
+  TNodeCylinder = class(TVRMLGeometryNode)
+  public
+  end;
+
+  TNodeIndexedFaceSet = class(TVRMLGeometryNode)
+  public
+    function TrianglesCount(ProxyGeometry: TVRMLGeometryNode): Cardinal; override;
+  end;
+
+function TVRMLGeometryNode.TrianglesCount(ProxyGeometry: TVRMLGeometryNode): Cardinal;
+begin
+  Writeln(ClassName, ': Default TrianglesCount implementation, passes the call to the Proxy or must be overridden');
+  if ProxyGeometry <> nil then
+    Result := ProxyGeometry.TrianglesCount(nil) else
+    raise Exception.CreateFmt('%s: TrianglesCount not overridden, and node without a Proxy', [ClassName]);
+end;
+
+function TNodeIndexedFaceSet.TrianglesCount(ProxyGeometry: TVRMLGeometryNode): Cardinal;
+begin
+  Result := 2;
+end;
+
+var
+  C: TNodeCylinder;
+  I: TNodeIndexedFaceSet;
+begin
+  C := TNodeCylinder.Create;
+  I := TNodeIndexedFaceSet.Create;
+  try
+    Writeln(C.TrianglesCount(I));
+  finally
+    FreeAndNil(C);
+    FreeAndNil(I);
+  end;
+end.

+ 18 - 0
tests/webtbs/tw17402a.pp

@@ -0,0 +1,18 @@
+{ %opt=-O2 -Cs1000000 }
+
+{$mode objfpc}
+{ check if tail recursion optimization works, at least on 32 bit OSes }
+function fac(i : int64) : int64;
+  var
+    a : array[0..100000] of longint;
+  begin
+    a[1]:=1;
+    if i=0 then
+      result:=1
+    else
+      result:=fac(i-1);
+  end;
+
+begin
+  fac(4000000);
+end.