[eval] support conditional breakpoints

src/macro/eval/evalContext.ml

@@ -78,6 +78,7 @@ type breakpoint = {
 	bpfile : int;
 	bpline : int;
 	bpcolumn : breakpoint_column;
+	bpcondition : Ast.expr option;
 	mutable bpstate : breakpoint_state;
 }
 

src/macro/eval/evalDebug.ml

@@ -57,6 +57,12 @@ let debug_loop jit e f =
 		| BPAny -> true
 		| BPColumn i -> i = col1
 	in
+	let condition_holds env breakpoint = match breakpoint.bpcondition with
+		| None -> true
+		| Some e -> match expr_to_value_safe ctx env e with
+			| VTrue -> true
+			| _ -> false
+	in
 	let conn = match ctx.debug.debug_socket with
 		| Some socket -> EvalDebugSocket.make_connection socket
 		| None -> EvalDebugCLI.connection
@@ -67,7 +73,7 @@ let debug_loop jit e f =
 			let h = Hashtbl.find ctx.debug.breakpoints env.env_info.pfile in
 			let breakpoint = Hashtbl.find h env.env_debug.line in
 			begin match breakpoint.bpstate with
-				| BPEnabled when column_matches breakpoint ->
+				| BPEnabled when column_matches breakpoint && condition_holds env breakpoint ->
 					breakpoint.bpstate <- BPHit;
 					ctx.debug.breakpoint <- breakpoint;
 					conn.bp_stop ctx env;

src/macro/eval/evalDebugCLI.ml

@@ -223,7 +223,7 @@ let rec wait ctx run env =
 			begin try
 				let file,line,column = parse_breakpoint_pattern pattern in
 				begin try
-					let breakpoint = add_breakpoint ctx file line column in
+					let breakpoint = add_breakpoint ctx file line column None in
 					output_breakpoint_set breakpoint;
 				with Not_found ->
 					output_error ("Could not find file " ^ file);

src/macro/eval/evalDebugMisc.ml

@@ -19,7 +19,7 @@ exception BreakHere
 
 let make_breakpoint =
 	let id = ref (-1) in
-	(fun file line state column ->
+	(fun file line state column condition ->
 		incr id;
 		{
 			bpid = !id;
@@ -27,6 +27,7 @@ let make_breakpoint =
 			bpline = line;
 			bpstate = state;
 			bpcolumn = column;
+			bpcondition = condition
 		}
 	)
 
@@ -35,7 +36,7 @@ let iter_breakpoints ctx f =
 		Hashtbl.iter (fun _ breakpoint -> f breakpoint) breakpoints
 	) ctx.debug.breakpoints
 
-let add_breakpoint ctx file line column =
+let add_breakpoint ctx file line column condition =
 	let hash = hash_s (Path.unique_full_path (Common.find_file (ctx.curapi.get_com()) file)) in
 	let h = try
 		Hashtbl.find ctx.debug.breakpoints hash
@@ -44,7 +45,7 @@ let add_breakpoint ctx file line column =
 		Hashtbl.add ctx.debug.breakpoints hash h;
 		h
 	in
-	let breakpoint = make_breakpoint hash line BPEnabled column in
+	let breakpoint = make_breakpoint hash line BPEnabled column condition in
 	Hashtbl.replace h line breakpoint;
 	breakpoint
 
@@ -143,7 +144,7 @@ let resolve_ident ctx env s =
 	with Not_found ->
 		raise Exit
 
-let expr_to_value ctx env e =
+let rec expr_to_value ctx env e =
 	let rec loop e = match fst e with
 		| EConst cst ->
 			begin match cst with
@@ -178,12 +179,73 @@ let expr_to_value ctx env e =
 		| EObjectDecl fl ->
 			let fl = List.map (fun ((s,_,_),e) -> s,loop e) fl in
 			encode_obj_s None fl
-		| _ ->
+		| EBinop(op,e1,e2) ->
+			begin match op with
+			| OpAssign ->
+				let v2 = loop e2 in
+				write_expr ctx env e1 v2;
+				v2
+			| OpAssignOp op ->
+				raise Exit (* Nobody does that, right? *)
+			| OpBoolAnd ->
+				if is_true (loop e1) then loop e2
+				else VFalse
+			| OpBoolOr ->
+				if is_true (loop e1) then VTrue
+				else loop e2
+			| _ ->
+				let v1 = loop e1 in
+				let v2 = loop e2 in
+				let p = pos e in
+				(get_binop_fun op p) v1 v2
+			end
+		| EUnop(op,flag,e1) ->
+			begin match op with
+			| Not ->
+				begin match loop e1 with
+				| VNull | VFalse -> VTrue
+				| _ -> VFalse
+				end
+			| Neg ->
+				begin match loop e1 with
+				| VFloat f -> VFloat (-.f)
+				| VInt32 i -> vint32 (Int32.neg i)
+				| _ -> raise Exit
+				end
+			| NegBits ->
+				op_sub (pos e) (vint32 (Int32.minus_one)) (loop e1)
+			| Increment | Decrement ->
+				raise Exit
+			end
+		| ECall(e1,el) ->
+			let v1 = loop e1 in
+			let vl = List.map loop el in
+			call_value v1 vl
+		| EBlock el ->
+			let rec loop2 el = match el with
+				| [] -> VNull
+				| [e1] -> loop e1
+				| e1 :: el ->
+					ignore(loop e1);
+					loop2 el
+			in
+			loop2 el
+		| EIf(e1,e2,eo) ->
+			let v1 = loop e1 in
+			if is_true v1 then loop e2
+			else Option.map_default loop VNull eo
+		| ETernary(e1,e2,e3) ->
+			let v1 = loop e1 in
+			if is_true v1 then loop e2 else loop e3
+		| EParenthesis e1 | EMeta(_,e1) | EUntyped e1 | ECast(e1,None) | ECheckType(e1,_) ->
+			loop e1
+		| EWhile _ | ETry _ | ESwitch _ | ENew _ | EVars _ | EFunction _ | EFor _ | EDisplay _
+		| EDisplayNew _ | EReturn _ | EContinue | EBreak | EThrow _  | ECast(_,Some _) ->
 			raise Exit
 	in
 	loop e
 
-let write_expr ctx env expr value =
+and write_expr ctx env expr value =
 	begin match fst expr with
 		| EField(e1,s) ->
 			let v1 = expr_to_value ctx env e1 in
@@ -207,4 +269,8 @@ let write_expr ctx env expr value =
 			end
 		| _ ->
 			raise Exit
-	end
+	end
+
+let expr_to_value_safe ctx env e =
+	try expr_to_value ctx env e
+	with Exit -> VNull

src/macro/eval/evalDebugSocket.ml

@@ -337,6 +337,18 @@ let make_connection socket =
 					let open JsonRpc in
 					raise (JsonRpc_error (Invalid_params id))
 				in
+				let parse_breakpoint = function
+					| JObject fl ->
+						let rec loop (line,column,condition) fl = match fl with
+							| ("line",JInt i) :: fl -> loop (i,column,condition) fl
+							| ("column",JInt i) :: fl -> loop (line,BPColumn i,condition) fl
+							| ("condition",JString s) :: fl -> loop (line,column,Some (parse_expr ctx s env.env_debug.expr.epos)) fl
+							| _ :: fl -> loop (line,column,condition) fl
+							| [] -> line,column,condition
+						in
+						loop (0,BPAny,None) fl
+					| _ -> invalid_params ()
+				in
 				let rec move_frame offset =
 					if offset < 0 || offset >= (get_eval ctx).environment_offset then begin
 						error (Printf.sprintf "Frame out of bounds: %i (valid range is %i - %i)" offset 0 ((get_eval ctx).environment_offset - 1))
@@ -369,15 +381,6 @@ let make_connection socket =
 						| Some (JObject fl) ->
 							let file = try List.find (fun (n,_) -> n = "file") fl with Not_found -> invalid_params () in
 							let file = match (snd file) with JString s -> s | _ -> invalid_params () in
-							let parse_breakpoint = function
-								| JObject fl ->
-									let line = try List.find (fun (n,_) -> n = "line") fl with Not_found -> invalid_params () in
-									let line = match (snd line) with JInt s -> s | _ -> invalid_params () in
-									let column = try Some (List.find (fun (n,_) -> n = "column") fl) with Not_found -> None in
-									let column = Option.map_default (fun (_,v) -> match v with JInt i -> BPColumn i | _ -> invalid_params ()) BPAny column in
-									line,column
-								| _ -> invalid_params ()
-							in
 							let bps = try List.find (fun (n,_) -> n = "breakpoints") fl with Not_found -> invalid_params () in
 							let bps = match (snd bps) with JArray jl -> jl | _ -> invalid_params () in
 							let bps = List.map parse_breakpoint bps in
@@ -396,28 +399,25 @@ let make_connection socket =
 							Hashtbl.add ctx.debug.breakpoints hash h;
 							h
 					in
-					let bps = List.map (fun (line,column) ->
-						let bp = make_breakpoint hash line BPEnabled column in
+					let bps = List.map (fun (line,column,condition) ->
+						let bp = make_breakpoint hash line BPEnabled column condition in
 						Hashtbl.add h line bp;
 						JObject ["id",JInt bp.bpid]
 					) bps in
 					Loop (JArray bps)
 				| "setBreakpoint" ->
-					let file,line,column =
+					let file,line,column,condition =
 						match params with
-						| Some (JObject fl) ->
+						| Some (JObject fl as jo) ->
 							let file = try List.find (fun (n,_) -> n = "file") fl with Not_found -> invalid_params () in
 							let file = match (snd file) with JString s -> s | _ -> invalid_params () in
-							let line = try List.find (fun (n,_) -> n = "line") fl with Not_found -> invalid_params () in
-							let line = match (snd line) with JInt s -> s | _ -> invalid_params () in
-							let column = try Some (List.find (fun (n,_) -> n = "column") fl) with Not_found -> None in
-							let column = Option.map_default (fun (_,v) -> match v with JInt i -> BPColumn i | _ -> invalid_params ()) BPAny column in
-							file,line,column
+							let line,column,condition = parse_breakpoint jo in
+							file,line,column,condition
 						| _ ->
 							invalid_params ();
 					in
 					begin try
-						let breakpoint = add_breakpoint ctx file line column in
+						let breakpoint = add_breakpoint ctx file line column condition in
 						Loop (JObject ["id",JInt breakpoint.bpid])
 					with Not_found ->
 						invalid_params ();

src/macro/eval/evalMain.ml

@@ -84,7 +84,7 @@ let create com api is_macro =
 				breakpoints = Hashtbl.create 0;
 				support_debugger = support_debugger;
 				debug_state = DbgStart;
-				breakpoint = EvalDebugMisc.make_breakpoint 0 0 BPDisabled BPAny;
+				breakpoint = EvalDebugMisc.make_breakpoint 0 0 BPDisabled BPAny None;
 				caught_types = Hashtbl.create 0;
 				environment_offset_delta = 0;
 				debug_socket = socket;

src/macro/eval/evalStdLib.ml

@@ -645,7 +645,7 @@ module StdContext = struct
 		let file = decode_string file in
 		let line = decode_int line in
 		begin try
-			ignore(EvalDebugMisc.add_breakpoint (get_ctx()) file line BPAny);
+			ignore(EvalDebugMisc.add_breakpoint (get_ctx()) file line BPAny None);
 		with Not_found ->
 			exc_string ("Could not find file " ^ file)
 		end;