FEAT: allowed function for a recovery of a caught throw

related to: Oldes/Rebol-issues#1521

Author: Oldes

src/boot/natives.reb

@@ -77,7 +77,7 @@ catch: native [
 	word [word! block!] {One or more names}
 	/all  {Catches all throws, named and unnamed}
 	/quit {Special catch for QUIT native}
-	/recover code [block!] "Code to be evaluated on a catch"
+	/recover code [block! function!] "Code to be evaluated on a catch"
 ]
 
 ;cause: native [

src/core/n-control.c

@@ -423,19 +423,14 @@ enum {
 		if (quit) {
 			// We are here because of a QUIT or HALT condition.
 			if (VAL_ERR_NUM(ret) == RE_QUIT)
-				ret = VAL_ERR_VALUE(ret);
+				*DS_RETURN = *(VAL_ERR_VALUE(ret));
 			else if (VAL_ERR_NUM(ret) == RE_HALT)
-				VAL_SET(ret, REB_UNSET);
+				VAL_SET(DS_RETURN, REB_UNSET);
 				//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;
+			goto recover;
 		}
 		if (!D_REF(ARG_CATCH_NAME)) return R_TOS1;
 	} else {
@@ -471,19 +466,39 @@ enum {
 				return R_RET;
 			}
 caught:     // Thrown is being caught.
-			// Store thrown value as the last result.
-			*ds = *(VAL_ERR_VALUE(ret));
-			*last_result = *ds;
+			// Store the thrown value as the return value...
+			*DS_RETURN = *(VAL_ERR_VALUE(ret));
+recover:	// ...and the last result.
+			*last_result = *DS_RETURN;
 			// If there is a recovery code, then evaluate it.
-			if (IS_BLOCK(&recover)) {
-				DS_NEXT;
-				DO_BLK(&recover);
-				DS_POP;
+			if (IS_FUNCTION(&recover)) {
+				// catch [throw 1] func[value name][value]
+				// Return result of the recovery function
+				REBVAL name = *DS_NEXT;
+				if(sym) {
+					Set_Word(&name, sym, 0, 0);
+					VAL_SET(&name, REB_WORD);
+				} else {
+					SET_NONE(&name);
+				}
+				Apply_Func(0, &recover, last_result, &name, 0);
 			}
-			return R_RET;
+			else if (IS_BLOCK(&recover)) {
+				// (catch/recover [throw 1][2]) == 2
+				// Return result of the recovery block evaluation.
+				*last_result = *DO_BLK(&recover);
+			}
+			else {
+				// (catch [throw 1]) == 1
+				// Return the thrown value.
+				return R_RET; 
+			}
+			// Return the result of the recovery code evaluation.
+			return R_TOS1;
 		}
 	}
-	// No throw, or a throw with unhandled name... return just result of the block evaluation
+	// No throw (return just the result of the block evaluation),
+	// or an unhandled throw (return the thrown error value, so it may be catched later)
 	return R_TOS1;
 }
 

src/tests/units/evaluation-test.r3

@@ -763,19 +763,66 @@ Rebol [
 		--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"
+	--test-- "catch/recover block!"
 	;@@ 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 10 = catch/quit/recover [a: 1 quit a: 2][a: a * 10]
+		--assert  a = 10
+
+		--assert 40 = catch/quit/recover [a: 1 quit/return 4 a: 2][system/state/last-result * 10]
+		--assert  a = 1
 
 		--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 10 = 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
+		--assert 30 = catch/recover [a: 1 throw 3 a: 2][system/state/last-result * 10]  
+		--assert a = 1
+
+		--assert all [
+			2 == catch/recover [throw 1][2 * system/state/last-result]
+			2 == system/state/last-result
+		]
+	--test-- "catch/recover function!"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/1521
+		on-catch: func[value name][
+			if :name = 'foo    [return join "b" :value]
+			if unset?   :value [return true]
+			if integer? :value [return value * 10]
+			mold value
+		]
+
+		--assert all [
+			#[true] == catch/quit/recover [a: 1 quit a: 2] :on-catch
+			a = 1
+		]
+
+		--assert all [
+			40 = catch/quit/recover [a: 1 quit/return 4 a: 2] :on-catch
+			a = 1
+		]
+
+		--assert all [
+			2 = catch/quit/recover [a: 2] :on-catch
+			a = 2
+		]
+
+		--assert all [
+			"x" = catch/recover [a: 1 throw 'x a: 2] :on-catch
+			'x  = system/state/last-result ;; or "x" ???
+			a = 1
+		]
+
+		--assert all [
+			30 = catch/recover [a: 1 throw 3 a: 2] :on-catch
+			a = 1
+		]
+
+		--assert all [
+			"b3" = catch/all/recover [a: 1 throw/name 3 'foo a: 2] :on-catch 
+			a = 1
+		]
 
 	--test-- "catch/quit/name"
 	;@@ https://github.com/Oldes/Rebol-issues/issues/2549