* when implicit try...finallys are turned off, do not throw an error if a procedure

is left which would need but does not have an implicit try...finally block, resolves #37823

git-svn-id: trunk@46974 -
This commit is contained in:
florian 2020-09-27 16:53:59 +00:00
parent a628c1c3dd
commit e1536bdf26
3 changed files with 24 additions and 1 deletions

1
.gitattributes vendored
View File

@ -18479,6 +18479,7 @@ tests/webtbs/tw37796.pp svneol=native#text/pascal
tests/webtbs/tw3780.pp svneol=native#text/plain
tests/webtbs/tw37806.pp svneol=native#text/pascal
tests/webtbs/tw3782.pp svneol=native#text/plain
tests/webtbs/tw37823.pp svneol=native#text/pascal
tests/webtbs/tw3796.pp svneol=native#text/plain
tests/webtbs/tw3805.pp svneol=native#text/plain
tests/webtbs/tw3814.pp svneol=native#text/plain

View File

@ -2193,7 +2193,8 @@ implementation
p2:=current_procinfo;
while true do
begin
if (p2.flags*[pi_needs_implicit_finally,pi_uses_exceptions,pi_has_implicit_finally])<>[] then
if ((cs_implicit_exceptions in current_settings.moduleswitches) and ((p2.flags*[pi_needs_implicit_finally,pi_has_implicit_finally])<>[])) or
((p2.flags*[pi_uses_exceptions])<>[]) then
Message(cg_e_goto_across_procedures_with_exceptions_not_allowed);
if labelsym.owner=p2.procdef.localst then
break;

21
tests/webtbs/tw37823.pp Normal file
View File

@ -0,0 +1,21 @@
{$MODE ISO}
{$implicitExceptions off}
{$Q+}
{$R+}
program gt;
label 1;
procedure jump;
var
a: integer;
b: rawbytestring;
begin
b := 'nanu';
writeln('nanu');
goto 1;
end;
begin
jump;
writeln('not jumped!');
1:
writeln('jumped!');
end.