mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 06:19:19 +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/tb0606.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb0607.pp svneol=native#text/plain
|
tests/tbs/tb0607.pp svneol=native#text/plain
|
||||||
tests/tbs/tb0608.pp svneol=native#text/pascal
|
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/tb205.pp svneol=native#text/plain
|
||||||
tests/tbs/tbs0594.pp svneol=native#text/pascal
|
tests/tbs/tbs0594.pp svneol=native#text/pascal
|
||||||
tests/tbs/ub0060.pp svneol=native#text/plain
|
tests/tbs/ub0060.pp svneol=native#text/plain
|
||||||
|
@ -268,7 +268,10 @@ implementation
|
|||||||
if (tsym(p).typ=paravarsym) then
|
if (tsym(p).typ=paravarsym) then
|
||||||
begin
|
begin
|
||||||
if tparavarsym(p).needs_finalization then
|
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
|
if (tparavarsym(p).varspez in [vs_value,vs_out]) and
|
||||||
(cs_create_pic in current_settings.moduleswitches) and
|
(cs_create_pic in current_settings.moduleswitches) and
|
||||||
(tf_pic_uses_got in target_info.flags) and
|
(tf_pic_uses_got in target_info.flags) and
|
||||||
@ -287,6 +290,7 @@ implementation
|
|||||||
is_managed_type(tlocalvarsym(p).vardef) then
|
is_managed_type(tlocalvarsym(p).vardef) then
|
||||||
begin
|
begin
|
||||||
include(current_procinfo.flags,pi_needs_implicit_finally);
|
include(current_procinfo.flags,pi_needs_implicit_finally);
|
||||||
|
include(current_procinfo.flags,pi_do_call);
|
||||||
if is_rtti_managed_type(tlocalvarsym(p).vardef) and
|
if is_rtti_managed_type(tlocalvarsym(p).vardef) and
|
||||||
(cs_create_pic in current_settings.moduleswitches) and
|
(cs_create_pic in current_settings.moduleswitches) and
|
||||||
(tf_pic_uses_got in target_info.flags) then
|
(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