* Set pi_do_call flag explicitly when procedure has a parameter or local var that require finalization. Normally it is set by implicit try..finally node, but this node is absent when compiling in {$implicitexceptions off} mode. This may cause internal errors in pass 2 if pi_do_call has not been set by other means.

Fixes IE when compiling Lazarus for MIPS target.
+ Test.

git-svn-id: trunk@29590 -
This commit is contained in:
sergei 2015-01-31 13:33:36 +00:00
parent c1091e1724
commit adeb8c93e9
3 changed files with 45 additions and 1 deletions

1
.gitattributes vendored
View File

@ -10351,6 +10351,7 @@ tests/tbs/tb0605.pp svneol=native#text/pascal
tests/tbs/tb0606.pp svneol=native#text/pascal
tests/tbs/tb0607.pp svneol=native#text/plain
tests/tbs/tb0608.pp svneol=native#text/pascal
tests/tbs/tb0609.pp svneol=native#text/plain
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/tbs0594.pp svneol=native#text/pascal
tests/tbs/ub0060.pp svneol=native#text/plain

View File

@ -268,7 +268,10 @@ implementation
if (tsym(p).typ=paravarsym) then
begin
if tparavarsym(p).needs_finalization then
include(current_procinfo.flags,pi_needs_implicit_finally);
begin
include(current_procinfo.flags,pi_needs_implicit_finally);
include(current_procinfo.flags,pi_do_call);
end;
if (tparavarsym(p).varspez in [vs_value,vs_out]) and
(cs_create_pic in current_settings.moduleswitches) and
(tf_pic_uses_got in target_info.flags) and
@ -287,6 +290,7 @@ implementation
is_managed_type(tlocalvarsym(p).vardef) then
begin
include(current_procinfo.flags,pi_needs_implicit_finally);
include(current_procinfo.flags,pi_do_call);
if is_rtti_managed_type(tlocalvarsym(p).vardef) and
(cs_create_pic in current_settings.moduleswitches) and
(tf_pic_uses_got in target_info.flags) then

39
tests/tbs/tb0609.pp Normal file
View File

@ -0,0 +1,39 @@
{ %norun }
{$mode objfpc}{$h+}
{$implicitexceptions off}
{ Test compilation of leaf function with managed parameter/local and implicit exceptions disabled. }
type
TCodeTreeNodeDesc = word;
TCodeTreeNode = class
Parent: TCodeTreeNode;
Desc: TCodeTreeNodeDesc;
function GetNodeOfTypes(Descriptors: array of TCodeTreeNodeDesc): TCodeTreeNode;
end;
function TCodeTreeNode.GetNodeOfTypes(Descriptors: array of TCodeTreeNodeDesc
): TCodeTreeNode;
var
i: Integer;
begin
Result:=Self;
while (Result<>nil) do begin
for i:=Low(Descriptors) to High(Descriptors) do
if Result.Desc=Descriptors[i] then exit;
Result:=Result.Parent;
end;
end;
procedure test;
var
s: string;
begin
pointer(s):=nil;
end;
begin
end.