mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 20:39:25 +02:00
* 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:
parent
c1091e1724
commit
adeb8c93e9
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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
39
tests/tbs/tb0609.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user