FEAT: new /recover option of the catch function

resolves: Oldes/Rebol-issues#1521
Oldes · Jun 20, 2023 · b917152 · b917152
1 parent d624e65
commit b917152
Show file tree

Hide file tree

Showing 3 changed files with 51 additions and 4 deletions.
diff --git 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
@@ -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
@@ -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===