FIX: throw error when trying to make invalid errors

related to: Oldes/Rebol-issues#1593

Author: Oldes

src/core/c-error.c

@@ -302,23 +302,29 @@ static REBOL_STATE Top_State; // Boot var: holds error state during boot
 **		to be bound to the error catalog context.
 **		If the message is not found, return null.
 **
+**	NOTE: throws invalid-arg error if id or type are not found
+**	      throws invalid-error if id or type are not words
+**
 ***********************************************************************/
 {
 	REBSER *frame;
 	REBVAL *obj1;
 	REBVAL *obj2;
 
-	if (!IS_WORD(&error->type) || !IS_WORD(&error->id)) return 0;
+	if (IS_NONE(&error->type) || IS_NONE(&error->id)) 
+		Trap0(RE_INVALID_ERROR);
 
 	// Find the correct error type object in the catalog:
+	if (!IS_WORD(&error->type)) goto invalid_type;
 	frame = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
 	obj1 = Find_Word_Value(frame, VAL_WORD_SYM(&error->type));
-	if (!obj1) return 0;
+	if (!obj1) goto invalid_type;
 
 	// Now find the correct error message for that type:
+	if (!IS_WORD(&error->id)) goto invalid_id;
 	frame = VAL_OBJ_FRAME(obj1);
 	obj2 = Find_Word_Value(frame, VAL_WORD_SYM(&error->id));
-	if (!obj2) return 0;
+	if (!obj2) goto invalid_id;
 
 	if (num) {
 		obj1 = Find_Word_Value(frame, SYM_CODE);
@@ -329,6 +335,11 @@ static REBOL_STATE Top_State; // Boot var: holds error state during boot
 	}
 
 	return obj2;
+invalid_type:
+	Trap1(RE_INVALID_ARG, &error->type);
+invalid_id:
+	Trap1(RE_INVALID_ARG, &error->id);
+	return 0; // just for compiler
 }
 
 
@@ -371,19 +382,20 @@ static REBOL_STATE Top_State; // Boot var: holds error state during boot
 		DISABLE_GC;
 		Do_Bind_Block(err, arg); // GC-OK (disabled)
 		ENABLE_GC;
-		if (IS_INTEGER(&error->code) && VAL_INT64(&error->code)) {
-			Set_Error_Type(error);
-		} else {
-			if (Find_Error_Info(error, &code)) {
-				SET_INTEGER(&error->code, code);
-			}
-		}
+		//It was possible to set error using code, but that's now ignored!
+		//@@ https://github.com/Oldes/Rebol-issues/issues/1593
+		//if (IS_INTEGER(&error->code) && VAL_INT64(&error->code)) {
+		//	Set_Error_Type(error);
+		//} else {
+			if (!Find_Error_Info(error, &code)) code = RE_INVALID_ERROR;
+			SET_INTEGER(&error->code, code);
+
+		//}
 		// The error code is not valid:
-		if (IS_NONE(&error->id)) {
-			SET_INTEGER(&error->code, RE_INVALID_ERROR);
+		if (VAL_INT64(&error->code) == RE_INVALID_ERROR) {
 			Set_Error_Type(error);
 		}
-		if (VAL_INT64(&error->code) < 100 || VAL_INT64(&error->code) > 1000)
+		if (VAL_INT64(&error->code) < 100) // || VAL_INT64(&error->code) > 1000) 
 			Trap_Arg(arg);
 	}
 

src/tests/run-tests.r3

@@ -23,6 +23,7 @@ dt [ ;- delta time
 		%units/delect-test.r3
 		%units/enbase-test.r3
 		%units/enum-test.r3
+		%units/error-test.r3
 		%units/evaluation-test.r3
 		%units/event-test.r3
 		%units/gob-test.r3

src/tests/units/error-test.r3

@@ -0,0 +1,66 @@
+Rebol [
+	Title:   "Rebol error test script"
+	Author:  "Oldes"
+	File: 	 %error-test.r3
+	Tabs:	 4
+	Needs:   [%../quick-test-module.r3]
+]
+
+~~~start-file~~~ "ERROR"
+
+===start-group=== "make error!"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/1593
+	--test-- "make error!"
+	k: keys-of system/catalog/errors/Math
+	--assert all [
+		error? e: make error! [type: 'math id: 'positive]
+		e/code = (system/catalog/errors/Math/code - 3 + index? find k 'positive)
+		e/type = 'Math
+		e/id   = 'positive
+	]
+	--assert all [
+		error? e: make error! [code: 500 type: 'math id: 'overflow] ;- code value 500 ignored!
+		e/code = (system/catalog/errors/Math/code - 3 + index? find k 'overflow) 
+		e/type = 'Math
+		e/id   = 'overflow
+	]
+
+	--test-- "make invalid error!"
+	--assert all [ ;missing type and id
+		error? e: try [make error! []]
+		e/type = 'Internal
+		e/id   = 'invalid-error
+	]
+	--assert all [ ;missing type and id
+		error? e: try [make error! [code: 400]]
+		e/type = 'Internal
+		e/id   = 'invalid-error
+	]
+	--assert all [ ;missing id
+		error? e: try [make error! [code: 500 type: 'math]]
+		e/type = 'Internal
+		e/id   = 'invalid-error
+	]
+	--assert all [
+		error? e: try [make error! [type: 'math id: 'foo]]
+		e/type = 'Script
+		e/id   = 'invalid-arg
+		e/arg1 = 'foo
+	]
+	--assert all [
+		error? e: try [make error! [type: 'math id: 42]]
+		e/type = 'Script
+		e/id   = 'invalid-arg
+		e/arg1 = 42
+	]
+
+	--assert all [
+		error? e: try [make error! [type: 'foo id: 'overflow]]
+		e/type = 'Script
+		e/id   = 'invalid-arg
+		e/arg1 = 'foo
+	]
+===end-group===
+
+
+~~~end-file~~~