paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 13:29:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Win64 SEH: Fixed handling control flow statements also in 'except' and 'on' parts of try..except statements.

Browse Source 
git-svn-id: trunk@24398 -
This commit is contained in:
sergei 2013-05-01 01:47:01 +00:00
parent bbc7d0c96b
commit 8c91cddfc8
2 changed files with 68 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
compiler/x86_64/nx64flw.pas
View File

@ -99,7 +99,7 @@ procedure tx64onnode.pass_generate_code;
location_reset(location,LOC_VOID,OS_NO);
oldflowcontrol:=flowcontrol;
flowcontrol:=[fc_inflowcontrol];
flowcontrol:=flowcontrol*[fc_unwind]+[fc_inflowcontrol];
{ RTL will put exceptobject into RAX when jumping here }
cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
@ -476,7 +476,7 @@ procedure tx64tryexceptnode.pass_generate_code;
current_procinfo.CurrBreakLabel:=breakexceptlabel;
end;
flowcontrol:=[fc_inflowcontrol];
flowcontrol:=flowcontrol*[fc_unwind]+[fc_inflowcontrol];
{ on statements }
if assigned(right) then
begin
@ -532,21 +532,30 @@ procedure tx64tryexceptnode.pass_generate_code;
{ do some magic for exit in the try block }
cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
if (fc_unwind in flowcontrol) then
cg.g_local_unwind(current_asmdata.CurrAsmList,oldCurrExitLabel)
else
cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
end;
if fc_break in exceptflowcontrol then
begin
cg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
if (fc_unwind in flowcontrol) then
cg.g_local_unwind(current_asmdata.CurrAsmList,oldCurrExitLabel)
else
cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
end;
if fc_continue in exceptflowcontrol then
begin
cg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
if (fc_unwind in flowcontrol) then
cg.g_local_unwind(current_asmdata.CurrAsmList,oldCurrExitLabel)
else
cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
end;
emit_nop;

62
tests/test/cg/ttryfin5.pp
View File

@ -1,9 +1,11 @@
{$mode objfpc}
uses sysutils;
var
counter: integer;
{ exit statement in try..except must not bypass finally code of outer try..finally }
{ flow control statements in try..except must not bypass finally code of outer try..finally }
{ test 1: 'exit' in 'try' block }
procedure test;
begin
try
@ -16,10 +18,54 @@ procedure test;
inc(counter);
end;
end;
begin
counter:=0;
test;
if counter<>2 then
Halt(1);
end.
{ test 2: 'exit' in 'except' block }
procedure test2;
begin
try
try
raise exception.create('catch me');
except
inc(counter);
exit;
end;
finally
inc(counter);
end;
end;
{ test 3: 'exit' in 'on' statement }
procedure test3;
begin
try
try
raise exception.create('catch me');
except
on E: Exception do
begin
inc(counter);
exit;
end;
end;
finally
inc(counter);
end;
end;
begin
counter:=0;
test;
if counter<>2 then
Halt(1);
counter:=0;
test2;
if counter<>2 then
Halt(2);
counter:=0;
test3;
if counter<>2 then
Halt(3);
end.