Browse Source

fixed TSwitch value with missing default

Nicolas Cannasse 8 years ago
parent
commit
e2912b5c43
3 changed files with 19 additions and 8 deletions
  1. 3 3
      src/generators/genhl.ml
  2. 13 2
      src/generators/hlinterp.ml
  3. 3 3
      src/macro/hlmacro.ml

+ 3 - 3
src/generators/genhl.ml

@@ -1364,7 +1364,7 @@ and eval_expr ctx e =
 			make_string ctx s e.epos
 			make_string ctx s e.epos
 		| TThis | TSuper ->
 		| TThis | TSuper ->
 			0 (* first reg *)
 			0 (* first reg *)
-		| _ ->
+		| TNull ->
 			let r = alloc_tmp ctx (to_type ctx e.etype) in
 			let r = alloc_tmp ctx (to_type ctx e.etype) in
 			op ctx (ONull r);
 			op ctx (ONull r);
 			r)
 			r)
@@ -2406,7 +2406,7 @@ and eval_expr ctx e =
 			let switch_pos = current_pos ctx in
 			let switch_pos = current_pos ctx in
 			(match def with
 			(match def with
 			| None ->
 			| None ->
-				if rt <> HVoid then op ctx (ONull r);
+				if rt <> HVoid then set_default ctx r;
 			| Some e ->
 			| Some e ->
 				let re = eval_to ctx e rt in
 				let re = eval_to ctx e rt in
 				if rt <> HVoid then op ctx (OMov (r,re)));
 				if rt <> HVoid then op ctx (OMov (r,re)));
@@ -3581,7 +3581,7 @@ let generate com =
 	end;
 	end;
 	if Common.raw_defined com "hl-check" then begin
 	if Common.raw_defined com "hl-check" then begin
 		check ctx;
 		check ctx;
-		Hlinterp.check code;
+		Hlinterp.check code false;
 	end;
 	end;
 	let t = Common.timer ["write";"hl"] in
 	let t = Common.timer ["write";"hl"] in
 	if file_extension com.file = "c" then
 	if file_extension com.file = "c" then

+ 13 - 2
src/generators/hlinterp.ml

@@ -2015,7 +2015,7 @@ let add_code ctx code =
 
 
 (* ------------------------------- CHECK ---------------------------------------------- *)
 (* ------------------------------- CHECK ---------------------------------------------- *)
 
 
-let check code =
+let check code macros =
 	let ftypes = Array.create (Array.length code.natives + Array.length code.functions) HVoid in
 	let ftypes = Array.create (Array.length code.natives + Array.length code.functions) HVoid in
 	let is_native_fun = Hashtbl.create 0 in
 	let is_native_fun = Hashtbl.create 0 in
 
 
@@ -2023,7 +2023,18 @@ let check code =
 		let pos = ref 0 in
 		let pos = ref 0 in
 		let error msg =
 		let error msg =
 			let dfile, dline = f.debug.(!pos) in
 			let dfile, dline = f.debug.(!pos) in
-			failwith (Printf.sprintf "\n%s:%d: Check failure at %d@x%x - %s" code.debugfiles.(dfile) dline f.findex (!pos) msg)
+			let file = code.debugfiles.(dfile) in
+			let msg = Printf.sprintf "Check failure at fun@%d @%X - %s" f.findex (!pos) msg in
+			if macros then begin
+				let low = dline land 0xFFFFF in
+				let pos = {
+					Globals.pfile = file;
+					Globals.pmin = low;
+					Globals.pmax = low + (dline lsr 20);
+				} in
+				Common.abort msg pos
+			end else
+				failwith (Printf.sprintf "\n%s:%d: %s" file dline msg)
 		in
 		in
 		let targs, tret = (match f.ftype with HFun (args,ret) -> args, ret | _ -> assert false) in
 		let targs, tret = (match f.ftype with HFun (args,ret) -> args, ret | _ -> assert false) in
 		let rtype i = try f.regs.(i) with _ -> HObj { null_proto with pname = "OUT_OF_BOUNDS:" ^ string_of_int i } in
 		let rtype i = try f.regs.(i) with _ -> HObj { null_proto with pname = "OUT_OF_BOUNDS:" ^ string_of_int i } in

+ 3 - 3
src/macro/hlmacro.ml

@@ -118,12 +118,12 @@ let add_types ctx types ready =
 		let code = Genhl.build_code gen types None in
 		let code = Genhl.build_code gen types None in
 		if debug then begin
 		if debug then begin
 			try
 			try
-				Hlinterp.check code
-			with Failure s ->
+				Hlinterp.check code true
+			with Failure _ | Common.Abort _ as exn ->
 				let ch = open_out_bin "hlcode.txt" in
 				let ch = open_out_bin "hlcode.txt" in
 				Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code;
 				Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code;
 				close_out ch;
 				close_out ch;
-				failwith s
+				raise exn
 		end;
 		end;
 		Hlinterp.add_code ctx.interp code
 		Hlinterp.add_code ctx.interp code