Browse Source

* fixed compilation of tw15391 with range checking enabled after r34034:
support maybe_call_procvar() on internal block nodes, which return
their result via the last statement

git-svn-id: trunk@34051 -

Jonas Maebe 9 years ago
parent
commit
8df1d1f9b8
3 changed files with 44 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 2 0
      compiler/nutils.pas
  3. 41 0
      tests/webtbs/tw15391a.pp

+ 1 - 0
.gitattributes

@@ -14258,6 +14258,7 @@ tests/webtbs/tw15370.pp svneol=native#text/plain
 tests/webtbs/tw15377.pp svneol=native#text/pascal
 tests/webtbs/tw1539.pp svneol=native#text/plain
 tests/webtbs/tw15391.pp svneol=native#text/plain
+tests/webtbs/tw15391a.pp svneol=native#text/plain
 tests/webtbs/tw15415.pp svneol=native#text/plain
 tests/webtbs/tw15446.pp svneol=native#text/plain
 tests/webtbs/tw15453a.pp svneol=native#text/plain

+ 2 - 0
compiler/nutils.pas

@@ -414,6 +414,8 @@ implementation
             typeconvn,
             subscriptn :
               hp:=tunarynode(hp).left;
+            blockn:
+              hp:=laststatement(tblocknode(hp)).left
             else
               break;
           end;

+ 41 - 0
tests/webtbs/tw15391a.pp

@@ -0,0 +1,41 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+{$r+}
+
+type
+  FuncA = function : Integer of object;
+  ObjA = class
+    function Func1: Integer;
+    procedure Proc1(const Arr: Array of FuncA);
+  end;
+
+var A : ObjA;
+
+procedure test(fa: funca);
+begin
+  if fa<>a.func1 then
+    halt(2);
+end;
+
+function ObjA.Func1: Integer;
+begin
+  Result := 1;
+end;
+
+procedure ObjA.Proc1(const Arr: Array of FuncA);
+begin
+  if (low(arr)<>0) or
+     (high(arr)<>1) or
+     assigned(arr[0]) or
+     (arr[1]<>a.func1) then
+    halt(1);
+end;
+
+begin
+  A := ObjA.Create;
+  A.Proc1([nil,A.Func1]);
+  test(a.func1);
+  a.free;
+end.