From 8c91cddfc86fac8e632fda3886f7f762014ee5a3 Mon Sep 17 00:00:00 2001 From: sergei Date: Wed, 1 May 2013 01:47:01 +0000 Subject: [PATCH] * Win64 SEH: Fixed handling control flow statements also in 'except' and 'on' parts of try..except statements. git-svn-id: trunk@24398 - --- compiler/x86_64/nx64flw.pas | 19 +++++++++--- tests/test/cg/ttryfin5.pp | 62 ++++++++++++++++++++++++++++++++----- 2 files changed, 68 insertions(+), 13 deletions(-) diff --git a/compiler/x86_64/nx64flw.pas b/compiler/x86_64/nx64flw.pas index 2407b1d188..97973ac3b5 100644 --- a/compiler/x86_64/nx64flw.pas +++ b/compiler/x86_64/nx64flw.pas @@ -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; diff --git a/tests/test/cg/ttryfin5.pp b/tests/test/cg/ttryfin5.pp index c484f8e8bd..f621742c20 100644 --- a/tests/test/cg/ttryfin5.pp +++ b/tests/test/cg/ttryfin5.pp @@ -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. \ No newline at end of file + +{ 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.