check for uncaught haxe.macro.Error exceptions (closes HaxeFoundation#53

)
frabbit · May 29, 2017 · 6794834 · 6794834
1 parent db24468
commit 6794834
Show file tree

Hide file tree

Showing 2 changed files with 46 additions and 32 deletions.
diff --git a/src/macro/eval/evalExceptions.ml b/src/macro/eval/evalExceptions.ml
@@ -22,11 +22,40 @@ open EvalContext
 open EvalValue
 open EvalPrinting
 open EvalHash
+open EvalField
 
 exception Break
 exception Continue
 exception Return of value
 
+let is v path =
+	path = key_Dynamic || match v with
+	| VInt32 _ -> path = key_Int || path = key_Float
+	| VFloat f -> path = key_Float || (path = key_Int && f = (float_of_int (int_of_float f)) && f <= 2147483647. && f >= -2147483648.)
+	| VTrue | VFalse -> path = key_Bool
+	| VPrototype {pkind = PClass _} -> path = key_Class
+	| VPrototype {pkind = PEnum _} -> path = key_Enum
+	| VEnumValue ve -> path = key_EnumValue || path = ve.epath
+	| VString _ -> path = key_String
+	| VArray _ -> path = key_Array
+	| VInstance vi ->
+		let has_interface path' =
+			try begin match (get_static_prototype_raise (get_ctx()) path').pkind with
+				| PClass interfaces -> List.mem path interfaces
+				| _ -> false
+			end with Not_found ->
+				false
+		in
+		let rec loop proto =
+			if path = proto.ppath || has_interface proto.ppath then true
+			else begin match proto.pparent with
+				| Some proto -> loop proto
+				| None -> false
+			end
+		in
+		loop vi.iproto
+	| _ -> false
+
 let s_value_kind = function
 	| VNull -> "VNull"
 	| VTrue -> "VTrue"
@@ -91,10 +120,23 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 	| RunTimeException(v,stack,p') ->
 		build_exception_stack ctx environment_offset;
 		eval.environment_offset <- environment_offset;
-		let msg = get_exc_error_message ctx v (match stack with [] -> [] | _ :: l -> l) (if p' = null_pos then p else p') in
-		get_ctx_ref := prev;
-		final();
-		Error.error msg null_pos
+		if is v key_haxe_macro_Error then begin
+			let v1 = field v key_message in
+			let v2 = field v key_pos in
+			get_ctx_ref := prev;
+			final();
+			match v1,v2 with
+				| VString(_,s),VInstance {ikind = IPos p} ->
+					raise (Error.Error (Error.Custom (Lazy.force s),p))
+				| _ ->
+					Error.error "Something went wrong" null_pos
+		end else begin
+			(* Careful: We have to get the message before resetting the context because toString() might access it. *)
+			let msg = get_exc_error_message ctx v (match stack with [] -> [] | _ :: l -> l) (if p' = null_pos then p else p') in
+			get_ctx_ref := prev;
+			final();
+			Error.error msg null_pos
+		end
 	| MacroApi.Abort ->
 		final();
 		None

diff --git a/src/macro/eval/evalMisc.ml b/src/macro/eval/evalMisc.ml
@@ -134,34 +134,6 @@ and equals_structurally a b =
 	| VPrototype proto1,VPrototype proto2 -> proto1.ppath = proto2.ppath
 	| _ -> a == b
 
-let is v path =
-	path = key_Dynamic || match v with
-	| VInt32 _ -> path = key_Int || path = key_Float
-	| VFloat f -> path = key_Float || (path = key_Int && f = (float_of_int (int_of_float f)) && f <= 2147483647. && f >= -2147483648.)
-	| VTrue | VFalse -> path = key_Bool
-	| VPrototype {pkind = PClass _} -> path = key_Class
-	| VPrototype {pkind = PEnum _} -> path = key_Enum
-	| VEnumValue ve -> path = key_EnumValue || path = ve.epath
-	| VString _ -> path = key_String
-	| VArray _ -> path = key_Array
-	| VInstance vi ->
-		let has_interface path' =
-			try begin match (get_static_prototype_raise (get_ctx()) path').pkind with
-				| PClass interfaces -> List.mem path interfaces
-				| _ -> false
-			end with Not_found ->
-				false
-		in
-		let rec loop proto =
-			if path = proto.ppath || has_interface proto.ppath then true
-			else begin match proto.pparent with
-				| Some proto -> loop proto
-				| None -> false
-			end
-		in
-		loop vi.iproto
-	| _ -> false
-
 let is_true v = match v with
 	| VTrue -> true
 	| _ -> false