redirect commands output to client when using server mode (fixed issue #1283)

common.ml

@@ -110,6 +110,7 @@ type context = {
 	mutable defines_signature : string option;
 	mutable print : string -> unit;
 	mutable get_macros : unit -> context option;
+	mutable run_command : string -> int;
 	(* output *)
 	mutable file : string;
 	mutable flash_version : float;
@@ -387,6 +388,7 @@ let create v args =
 		platform = Cross;
 		config = default_config;
 		print = print_string;
+		run_command = Sys.command;
 		std_path = [];
 		class_path = [];
 		main_class = None;

gencpp.ml

@@ -209,7 +209,7 @@ let include_class_header = function
 	| path -> not ( is_internal_class path )
 
 
-let is_cpp_class = function 
+let is_cpp_class = function
 	| ("cpp"::_ , _)  -> true
 	| ( [] , "Xml" )  -> true
 	| ( [] , "EReg" )  -> true
@@ -378,7 +378,7 @@ and type_string_suff suffix haxe_type =
 	| TAbstract ({ a_path = ([],"Bool") },[]) -> "bool"
 	| TAbstract ({ a_path = ([],"Float") },[]) -> "Float"
 	| TAbstract ({ a_path = ([],"Int") },[]) -> "int"
-	| TAbstract( { a_path = ([], "EnumValue") }, _  ) -> "Dynamic"
+	| TAbstract( { a_path = ([], "EnumValue") }, _  ) -> "Dynamic"
 	| TEnum ({ e_path = ([],"Void") },[]) -> "Void"
 	| TEnum ({ e_path = ([],"Bool") },[]) -> "bool"
 	| TInst ({ cl_path = ([],"Float") },[]) -> "Float"
@@ -1824,7 +1824,7 @@ let is_override class_def field =
    List.mem field class_def.cl_overrides
 ;;
 
-let rec all_virtual_functions clazz = 
+let rec all_virtual_functions clazz =
    (List.fold_left (fun result elem -> match follow elem.cf_type, elem.cf_kind  with
 		| TFun (args,return_type), Method _  when not (is_override clazz elem.cf_name ) -> (elem,args,return_type) :: result
       | _,_ -> result ) [] clazz.cl_ordered_fields)
@@ -1832,7 +1832,7 @@ let rec all_virtual_functions clazz =
    | Some def -> all_virtual_functions (fst def)
    | _ -> [] )
 ;;
- 
+
 
 			   (* external mem  Dynamic & *)
 
@@ -2253,7 +2253,7 @@ let generate_boot common_ctx boot_classes init_classes =
 		output_boot ("::" ^ ( join_class_path class_path "::" ) ^ "_obj::__register();\n") ) boot_classes;
 	List.iter ( fun class_path ->
 		output_boot ("::" ^ ( join_class_path class_path "::" ) ^ "_obj::__init__();\n") ) (List.rev init_classes);
-   let dump_boot = 
+   let dump_boot =
 	List.iter ( fun class_path ->
 		output_boot ("::" ^ ( join_class_path class_path "::" ) ^ "_obj::__boot();\n") ) in
    dump_boot (List.filter  (fun path -> is_cpp_class path )  (List.rev boot_classes));
@@ -2550,7 +2550,7 @@ let generate_class_files common_ctx member_types super_deps constructor_deps cla
 						| Some { eexpr = TFunction function_def } ->
 							List.map (fun (v,o) -> gen_arg_type_name v.v_name o v.v_type "__o_")
 									function_def.tf_args;
-						| _ -> 
+						| _ ->
 							(match follow definition.cf_type with
 								| TFun (args,_) -> List.map (fun (a,_,t) -> (type_string t,a) )  args
 								| _ -> [])
@@ -2747,7 +2747,7 @@ let generate_class_files common_ctx member_types super_deps constructor_deps cla
 		let get_field_dat = List.map (fun f ->
 			(f.cf_name, String.length f.cf_name, "return " ^
 				(match f.cf_kind with
-				| Var { v_read = AccCall prop } -> "inCallProp ? " ^ (keyword_remap prop) ^ "() : " ^ 
+				| Var { v_read = AccCall prop } -> "inCallProp ? " ^ (keyword_remap prop) ^ "() : " ^
 				        ((keyword_remap f.cf_name) ^ if (variable_field f) then "" else "_dyn()")
 				| _ -> ((keyword_remap f.cf_name) ^ if (variable_field f) then "" else "_dyn()")
 				) ^ ";"
@@ -3316,7 +3316,7 @@ let generate common_ctx =
 		);
 	) common_ctx.types;
 
-   
+
 	(match common_ctx.main with
 	| None -> generate_dummy_main common_ctx
 	| Some e ->
@@ -3346,7 +3346,7 @@ let generate common_ctx =
 		if (common_ctx.debug) then cmd := !cmd ^ " -Ddebug";
 		PMap.iter ( fun name _ -> cmd := !cmd ^ " -D" ^ name ^ "" ) common_ctx.defines;
 		print_endline !cmd;
-		if Sys.command !cmd <> 0 then failwith "Build failed";
+		if common_ctx.run_command !cmd <> 0 then failwith "Build failed";
 		Sys.chdir old_dir;
 	end
 	;;

genjava.ml

@@ -1400,8 +1400,8 @@ let configure gen =
         begin_block w;
         (try
           let t = Hashtbl.find gen.gtypes ([], "Sys") in
-              match t with 
-                | TClassDecl(cl) when PMap.mem "_args" cl.cl_statics -> 
+              match t with
+                | TClassDecl(cl) when PMap.mem "_args" cl.cl_statics ->
                   write w "Sys._args = args;"; newline w
                 | _ -> ()
         with | Not_found -> ()
@@ -1843,7 +1843,7 @@ let configure gen =
 		Sys.chdir gen.gcon.file;
 		let cmd = "haxelib run hxjava hxjava_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) in
 		print_endline cmd;
-		if Sys.command cmd <> 0 then failwith "Build failed";
+		if gen.gcon.run_command cmd <> 0 then failwith "Build failed";
 		Sys.chdir old_dir;
 	end;
 
@@ -1993,7 +1993,7 @@ let convert_java_field p jc field =
     | AttrDeprecated -> cff_meta := (":deprecated", [], p) :: !cff_meta
     (* TODO: pass anotations as @:meta *)
     | AttrVisibleAnnotations ann ->
-      List.iter (function 
+      List.iter (function
         | { ann_type = TObject( (["java";"lang"], "Override"), [] ) } ->
           cff_access := AOverride :: !cff_access
         | _ -> ()
@@ -2002,7 +2002,7 @@ let convert_java_field p jc field =
   ) field.jf_attributes;
 
   let kind = match field.jf_kind with
-    | JKField -> 
+    | JKField ->
       FVar (Some (convert_signature p field.jf_signature), convert_constant p field.jf_constant)
     | JKMethod ->
       match field.jf_signature with
@@ -2029,7 +2029,7 @@ let convert_java_field p jc field =
               tp_constraints = List.map (convert_signature p) (impl);
             }
         ) field.jf_types in
-        
+
         FFun ({
           f_params = types;
           f_args = args;
@@ -2064,7 +2064,7 @@ let convert_java_class p jc =
       | JAnnotation -> meta := (":annotation", [], p) :: !meta
       | _ -> ()
     ) jc.cflags;
-    
+
     (match jc.csuper with
       | TObject( (["java";"lang"], "Object"), _ ) -> ()
       | TObject( (["haxe";"lang"], "HxObject"), _ ) -> meta := (":hxgen",[],p) :: !meta
@@ -2097,7 +2097,7 @@ let convert_java_class p jc =
 
 
 let add_java_lib com file =
-  let get_raw_class, close = 
+  let get_raw_class, close =
     let file = if Sys.file_exists file then
       file
     else if Sys.file_exists (file ^ ".jar") then
@@ -2114,12 +2114,12 @@ let add_java_lib com file =
         try
           let data = Std.input_file ~bin:true real_path in
           Some (IO.input_string data), real_path, real_path
-        with 
+        with
           | _ -> None, real_path, real_path), (fun () -> ())
     | false -> (* open zip file *)
       let zip = Zip.open_in file in
       let closed = ref false in
-      (fun (pack, name) -> 
+      (fun (pack, name) ->
         if !closed then failwith "JAR file already closed";
         try
           let location = (String.concat "/" (pack @ [name]) ^ ".class") in
@@ -2127,7 +2127,7 @@ let add_java_lib com file =
           let data = Zip.read_entry zip entry in
           Some (IO.input_string data), file, file ^ "@" ^ location
         with
-          | Not_found -> 
+          | Not_found ->
             None, file, file),
       (fun () -> closed := true; Zip.close_in zip)
   in

genneko.ml

@@ -830,7 +830,7 @@ let generate com =
 		Nbytecode.write ch (Ncompile.compile ctx.version e);
 		IO.close_out ch;
 	end;
-	let command cmd = try Sys.command cmd with _ -> -1 in
+	let command cmd = try com.run_command cmd with _ -> -1 in
 	let neko_file = (try Filename.chop_extension com.file with _ -> com.file) ^ ".neko" in
 	if source || use_nekoc then begin
 		let ch = IO.output_channel (open_out_bin neko_file) in

interp.ml

@@ -1613,7 +1613,7 @@ let std_lib =
 			VBool (Sys.word_size = 64)
 		);
 		"sys_command", Fun1 (fun cmd ->
-			VInt (Sys.command (vstring cmd))
+			VInt ((get_ctx()).com.run_command (vstring cmd))
 		);
 		"sys_exit", Fun1 (fun code ->
 			exit (vint code);

main.ml

@@ -310,9 +310,10 @@ let run_command ctx cmd =
 	let t = Common.timer "command" in
 	let cmd = expand_env ~h:(Some h) cmd in
 	let len = String.length cmd in
-	if len > 3 && String.sub cmd 0 3 = "cd " then
-		Sys.chdir (String.sub cmd 3 (len - 3))
-	else
+	if len > 3 && String.sub cmd 0 3 = "cd " then begin
+		Sys.chdir (String.sub cmd 3 (len - 3));
+		0
+	end else
 	let binary_string s =
 		if Sys.os_type <> "Win32" && Sys.os_type <> "Cygwin" then s else String.concat "\n" (Str.split (Str.regexp "\r\n") s)
 	in
@@ -357,10 +358,12 @@ let run_command ctx cmd =
 	let sout = binary_string (Buffer.contents bout) in
 	if serr <> "" then ctx.messages <- (if serr.[String.length serr - 1] = '\n' then String.sub serr 0 (String.length serr - 1) else serr) :: ctx.messages;
 	if sout <> "" then ctx.com.print sout;
-	(match (try Unix.close_process_full (pout,pin,perr) with Unix.Unix_error (Unix.ECHILD,_,_) -> (match !result with None -> assert false | Some r -> r)) with
-	| Unix.WEXITED e -> if e <> 0 then failwith ("Command failed with error " ^ string_of_int e)
-	| Unix.WSIGNALED s | Unix.WSTOPPED s -> failwith ("Command stopped with signal " ^ string_of_int s));
-	t()
+	let r = (match (try Unix.close_process_full (pout,pin,perr) with Unix.Unix_error (Unix.ECHILD,_,_) -> (match !result with None -> assert false | Some r -> r)) with
+		| Unix.WEXITED e -> e
+		| Unix.WSIGNALED s | Unix.WSTOPPED s -> if s = 0 then -1 else s
+	) in
+	t();
+	r
 
 let default_flush ctx =
 	List.iter prerr_endline (List.rev ctx.messages);
@@ -712,6 +715,7 @@ try
 	Common.define_value com Define.Dce "std";
 	com.warning <- (fun msg p -> message ctx ("Warning : " ^ msg) p);
 	com.error <- error ctx;
+	if !global_cache <> None then com.run_command <- run_command ctx;
 	Parser.display_error := (fun e p -> com.error (Parser.error_msg e) p);
 	Parser.use_doc := !Common.display_default || (!global_cache <> None);
 	(try
@@ -1142,7 +1146,10 @@ try
 		);
 	end;
 	Sys.catch_break false;
-	if not !no_output then List.iter (run_command ctx) (List.rev !cmds)
+	if not !no_output then List.iter (fun c ->
+		let r = run_command ctx c in
+		if r <> 0 then failwith ("Command failed with error " ^ string_of_int r)
+	) (List.rev !cmds)
 with
 	| Abort | Typecore.Fatal_error ->
 		()