FEAT: implemented try/all to catch also thrown exceptions

related to:
Oldes/Rebol-issues#583
Oldes/Rebol-issues#1506

Author: Oldes

make/tools/make-headers.reb

@@ -320,6 +320,7 @@ context [
 		request-file
 		request-dir
 		catch
+		try
 	] [make-arg-enums word]
 
 ;?? output

src/boot/errors.reb

@@ -19,7 +19,6 @@ Throw: [
 	type: "throw error"
 	break:              {no loop to break}
 	return:             {return or exit not in function}
-	unnamed-throw:      [{no catch for unnamed throw with value:} :arg1]
 	throw:              [{no catch for throw:} :arg2 "with value:" :arg1]
 	continue:           {no loop to continue}
 	halt:               [{halted by user or script}]
@@ -247,3 +246,4 @@ Internal: [
 	not-done:           {reserved for future use (or not yet implemented)}
 	invalid-error:      {error object or fields were not valid}
 ]
+

src/boot/natives.reb

@@ -311,6 +311,7 @@ trace: native [
 try: native [
 	{Tries to DO a block and returns its value or an error!.}
 	block [block! paren!]
+	/all    "Catch also BREAK, CONTINUE, RETURN, EXIT and THROW exceptions."
 	/with   "On error, evaluate the handler and return its result"
 	handler [block! any-function!]
 	/except "** DEPRERCATED **"

src/core/c-error.c

@@ -443,6 +443,9 @@ static REBOL_STATE Top_State; // Boot var: holds error state during boot
 	// Make a copy of the error object template:
 	err = CLONE_OBJECT(VAL_OBJ_FRAME(ROOT_ERROBJ));
 	error = ERR_VALUES(err);
+	
+	if (code >= THROWN_DISARM_OFFSET)
+		code -= THROWN_DISARM_OFFSET;
 
 	// Set error number:
 	SET_INTEGER(&error->code, (REBINT)code);
@@ -465,6 +468,40 @@ static REBOL_STATE Top_State; // Boot var: holds error state during boot
 }
 
 
+/***********************************************************************
+**
+*/	REBSER *Disarm_Throw_Error(REBVAL *err)
+/*
+**		Creates real error object from an internal thrown one
+**
+***********************************************************************/
+{
+	REBINT code;
+	REBCNT sym;
+	REBSER *obj;
+	REBVAL *arg1 = NULL;
+	REBVAL word = {0};
+
+	code = VAL_ERR_NUM(err);
+	if (code > RE_THROW_MAX) return VAL_ERR_OBJECT(err);
+
+	sym  = VAL_ERR_SYM(err);
+	arg1 = VAL_ERR_VALUE(err);
+	
+	if (sym) {
+		Set_Word(&word, sym, 0, 0);
+		VAL_SET(&word, REB_WORD);
+		VAL_ERR_SYM(err) = 0;
+	}
+
+	code += THROWN_DISARM_OFFSET;
+	
+	obj = Make_Error(code, arg1, sym ? &word : 0, 0);
+	VAL_ERR_OBJECT(err) = obj;
+	VAL_ERR_NUM(err) = code;
+}
+
+
 /***********************************************************************
 **
 */	void Trap0(REBCNT num)

src/core/n-control.c

@@ -886,41 +886,46 @@ enum {
 /*
 ***********************************************************************/
 {
-	REBFLG   with = D_REF(2);
+	REBFLG   with = D_REF(ARG_TRY_WITH);
 	REBVAL   handler;
-	REBVAL  *last_error = Get_System(SYS_STATE, STATE_LAST_ERROR);
-	SET_NONE(last_error);
+	REBVAL  *error = Get_System(SYS_STATE, STATE_LAST_ERROR);
+	SET_NONE(error); // reset the last error
+
 
 	// If not used the new /with refine, try to use the deprecated /except
 	if (with) {
-		handler = *D_ARG(3);
+		handler = *D_ARG(ARG_TRY_HANDLER);
 	} else {
-		with    =  D_REF(4);
-		handler = *D_ARG(5);
+		with    =  D_REF(ARG_TRY_EXCEPT);
+		handler = *D_ARG(ARG_TRY_CODE);
 	}
 	// TRY exception will trim the stack
-	if (Try_Block(VAL_SERIES(D_ARG(1)), VAL_INDEX(D_ARG(1)))) {
+	if (Try_Block(VAL_SERIES(D_ARG(ARG_TRY_BLOCK)), VAL_INDEX(D_ARG(ARG_TRY_BLOCK)))) {
 		// save the error as a system/state/last-error value
-		*last_error = *DS_NEXT;
+	on_error:
+		*error = *DS_NEXT;
 
 		if (with) {
 			if (IS_BLOCK(&handler)) {
 				DO_BLK(&handler);
 			}
 			else { // do func[err] error
-				REBVAL error = *DS_NEXT; // will get overwritten
 				REBVAL *args = BLK_SKIP(VAL_FUNC_ARGS(&handler), 1);
-				if (NOT_END(args) && !TYPE_CHECK(args, VAL_TYPE(&error))) {
+				if (NOT_END(args) && !TYPE_CHECK(args, VAL_TYPE(error))) {
 					// TODO: This results in an error message such as "action!
 					// does not allow error! for its value1 argument". A better
 					// message would be more like "except handler does not
 					// allow error! for its value1 argument."
-					Trap3(RE_EXPECT_ARG, Of_Type(&handler), args, Of_Type(&error));
+					Trap3(RE_EXPECT_ARG, Of_Type(&handler), args, Of_Type(error));
 				}
-				Apply_Func(0, &handler, &error, 0);
+				Apply_Func(0, &handler, error, 0);
 			}
 		}
 	}
+	else if (D_REF(ARG_TRY_ALL) && THROWN(DS_NEXT)) {
+		Disarm_Throw_Error(DS_NEXT);
+		goto on_error;
+	}
 
 	return R_TOS1;
 }

src/core/s-mold.c

@@ -1051,35 +1051,15 @@ STOID Mold_Error(REBVAL *value, REB_MOLD *mold, REBFLG molded)
 
 	// Protect against recursion. !!!!
 
+	if (VAL_ERR_NUM(value) < RE_THROW_MAX) {
+		Disarm_Throw_Error(value);
+	}
+
 	if (molded) {
-		if (VAL_OBJ_FRAME(value) && VAL_ERR_NUM(value) >= RE_NOTE && VAL_ERR_OBJECT(value))
-			Mold_Object(value, mold);
-		else {
-			// Happens if throw or return is molded.
-			// make error! 0-3
-			Pre_Mold(value, mold);
-			Append_Int(mold->series, VAL_ERR_NUM(value));
-			End_Mold(mold);
-		}
+		Mold_Object(value, mold);
 		return;
 	}
 
-	// If it is an unprocessed THROW:
-	if (VAL_ERR_NUM(value) == RE_THROW) {
-		sym = VAL_ERR_SYM(value);
-		if (!sym) {
-			VAL_ERR_OBJECT(value) = Make_Error(RE_UNNAMED_THROW, VAL_ERR_VALUE(value), 0, 0);
-		}
-		else {
-			Set_Word(&word, sym, 0, 0);
-			VAL_SET(&word, REB_WORD);
-			VAL_ERR_OBJECT(value) = Make_Error(VAL_ERR_NUM(value), VAL_ERR_VALUE(value), &word, 0);
-		}
-	}
-	// If it is an unprocessed BREAK, CONTINUE, RETURN:
-	else if (VAL_ERR_NUM(value) < RE_NOTE || !VAL_ERR_OBJECT(value)) {
-		VAL_ERR_OBJECT(value) = Make_Error(VAL_ERR_NUM(value), VAL_ERR_VALUE(value), 0, 0); // spoofs field
-	}
 	err = VAL_ERR_VALUES(value);
 
 	// Form: ** <type> Error:

src/include/sys-value.h

@@ -952,6 +952,8 @@ typedef struct Reb_Error {
 #define	IS_CONTINUE(v)		(VAL_ERR_NUM(v) == RE_CONTINUE)
 #define THROWN(v)			(IS_ERROR(v) && IS_THROW(v))
 
+#define THROWN_DISARM_OFFSET 100000 // used to disarm thrown errors (converted to complete error object)
+
 #define	SET_ERROR(v,n,a)	VAL_SET(v, REB_ERROR), VAL_ERR_NUM(v)=n, VAL_ERR_OBJECT(v)=a, VAL_ERR_SYM(v)=0
 #define	SET_THROW(v,n,a)	VAL_SET(v, REB_ERROR), VAL_ERR_NUM(v)=n, VAL_ERR_VALUE(v)=a, VAL_ERR_SYM(v)=0
 

src/tests/units/evaluation-test.r3

@@ -728,6 +728,47 @@ Rebol [
 		--assert string? try/with [1 / 0] :mold
 		--assert system/state/last-error/id = 'zero-divide
 
+	--test-- "try/all"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/1506
+		--assert error? try/all [break]
+		--assert error? try/all [continue]
+		--assert error? try/all [exit]
+		--assert error? try/all [return 1]
+		--assert error? try/all [throw 1]
+
+	--test-- "try/all/with block handler"
+		handler: [system/state/last-error/id]
+		--assert 'break    = try/all/with [break   ] :handler
+		--assert 'continue = try/all/with [continue] :handler
+		--assert 'return   = try/all/with [exit    ] :handler
+		--assert 'return   = try/all/with [return 1] :handler
+		--assert 'throw    = try/all/with [throw 1 ] :handler
+
+	--test-- "try/all/with function handler"
+		--assert 'break = try/all/with [break] func[e][e/id]
+
+		--assert all [
+			string? try/all/with [break] :mold
+			system/state/last-error/id = 'break
+			system/state/last-error/arg1 = none
+		]
+		--assert all [
+			string? try/all/with [exit] :mold
+			system/state/last-error/id = 'return
+			system/state/last-error/arg1 = none
+		]
+		--assert all [
+			string? try/all/with [throw 1] :mold
+			system/state/last-error/id = 'throw
+			system/state/last-error/arg1 = 1
+		]
+		--assert all [
+			string? try/all/with [throw/name 1 'foo] :mold
+			system/state/last-error/id = 'throw
+			system/state/last-error/arg1 = 1
+			system/state/last-error/arg2 = 'foo
+		]
+
 ===end-group===