* 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 -
This commit is contained in:
Jonas Maebe 2016-07-02 21:09:59 +00:00
parent ac5658470e
commit 8df1d1f9b8
3 changed files with 44 additions and 0 deletions

1
.gitattributes vendored
View File

@ -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

View File

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

41
tests/webtbs/tw15391a.pp Normal file
View File

@ -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.