From b917152bccfd7828e8d29114b5a7ae1a34478210 Mon Sep 17 00:00:00 2001 From: Oldes Date: Tue, 20 Jun 2023 11:22:36 +0200 Subject: [PATCH] FEAT: new `/recover` option of the `catch` function resolves: https://github.com/Oldes/Rebol-issues/issues/1521 --- src/boot/natives.reb | 1 + src/core/n-control.c | 18 +++++++++++++-- src/tests/units/evaluation-test.r3 | 36 ++++++++++++++++++++++++++++-- 3 files changed, 51 insertions(+), 4 deletions(-) diff --git a/src/boot/natives.reb b/src/boot/natives.reb index bbb39ae9aa..7f2c203661 100644 --- a/src/boot/natives.reb +++ b/src/boot/natives.reb @@ -76,6 +76,7 @@ catch: native [ /name {Catches a named throw} word [word! block!] {One or more names} /quit {Special catch for QUIT native} + /recover code [block!] "Code to be evaluated on a catch" ] ;cause: native [ diff --git a/src/core/n-control.c b/src/core/n-control.c index c2f6c057b7..3ccef76d36 100644 --- a/src/core/n-control.c +++ b/src/core/n-control.c @@ -413,10 +413,12 @@ enum { REBVAL *val; REBVAL *ret; REBCNT sym; + REBVAL recover = *D_ARG(6); + REBVAL *last_result = Get_System(SYS_STATE, STATE_LAST_RESULT); if (D_REF(4)) { //QUIT if (Try_Block_Halt(VAL_SERIES(D_ARG(1)), VAL_INDEX(D_ARG(1)))) { - // We are here because of a QUIT/HALT condition. + // We are here because of a QUIT or HALT condition. ret = DS_NEXT; if (VAL_ERR_NUM(ret) == RE_QUIT) ret = VAL_ERR_VALUE(ret); @@ -425,6 +427,11 @@ enum { //Halt_Code(RE_HALT, 0); // Don't use this if we want to be able catch all! else Crash(RP_NO_CATCH); + + if (IS_BLOCK(&recover)) { + DO_BLK(&recover); + } + *DS_RETURN = *ret; return R_RET; } @@ -455,10 +462,17 @@ enum { } else { got_err: *ds = *(VAL_ERR_VALUE(ret)); + *last_result = *ds; + if (IS_BLOCK(&recover)) { + DS_NEXT; + DO_BLK(&recover); + DS_POP; + } + return R_RET; } } - + // No throw, or a throw with unhandled name... return just result of the block evaluation return R_TOS1; } diff --git a/src/tests/units/evaluation-test.r3 b/src/tests/units/evaluation-test.r3 index 9d48a94c83..fdb6a303ce 100644 --- a/src/tests/units/evaluation-test.r3 +++ b/src/tests/units/evaluation-test.r3 @@ -731,6 +731,10 @@ Rebol [ ===start-group=== "CATCH" + ;@@ https://github.com/Oldes/Rebol-issues/issues/1518 + ;@@ https://github.com/Oldes/Rebol-issues/issues/1520 + ;@@ https://github.com/Oldes/Rebol-issues/issues/1734 + ;@@ https://github.com/Oldes/Rebol-issues/issues/1742 --test-- "catch/quit [halt]" ;@@ https://github.com/Oldes/Rebol-issues/issues/1742 a: 0 catch/quit [++ a halt ++ a] @@ -740,11 +744,39 @@ Rebol [ ;@@ https://github.com/Oldes/Rebol-issues/issues/1734 a: 0 --assert unset? catch/quit [++ a quit ++ a] - --assert a == 1; + --assert a == 1 --assert 100 = catch/quit [++ a quit/return 100 ++ a] - --assert a == 2; + --assert a == 2 --assert 0 = call/shell/wait join system/options/boot { --do "quit"} --assert 100 = call/shell/wait join system/options/boot { --do "quit/return 100"} + --test-- "nested catch" + a: 0 + --assert 'x = catch [++ a catch/quit [++ a quit a: 0] a: a * 2 throw 'x a: a * 100] + --assert a == 4 + a: 0 + --assert 'x = catch [++ a catch/quit [++ a throw 'x a: 0] a: a * 2 quit 'x a: a * 100] + --assert a == 2 + a: 0 + --assert unset? catch/quit [++ a a: a + catch [++ a throw 100 a: 0] a: a * 2 quit a: a * 100] + --assert a == 202 + a: 0 + --assert unset? catch/quit [++ a a: a + catch [++ a quit a: 0] a: a * 2 throw 100 a: a * 100] + --assert a == 2 + + --test-- "catch/recover" + ;@@ https://github.com/Oldes/Rebol-issues/issues/1521 + --assert unset? catch/quit/recover [a: 1 quit a: 2][a: a * 10] + --assert a = 10 + + --assert 2 = catch/quit/recover [a: 2][a: a * 10] + --assert a = 2 + + --assert 'x = catch/recover [a: 1 throw 'x a: 2][a: a * 10] + --assert a = 10 + + --assert 3 = catch/recover [a: 1 throw 3 a: 2][a: system/state/last-result a: a * 10] + --assert a = 30 + ===end-group===