Переглянути джерело

use thread to read in parallel both stderr and stdout (close #1654, close #3859)

Nicolas Cannasse 8 роки тому
батько
коміт
6bd7d262e0
2 змінених файлів з 12 додано та 46 видалено
  1. 3 3
      Makefile
  2. 9 43
      src/compiler/main.ml

+ 3 - 3
Makefile

@@ -29,7 +29,7 @@ STATICLINK?=0
 
 HAXE_DIRECTORIES=compiler context generators generators/gencommon macro filters optimization syntax typing display
 EXTLIB_LIBS=extlib extc neko javalib ziplib swflib xml-light ttflib ilib objsize pcre
-FINDLIB_LIBS=unix str
+FINDLIB_LIBS=unix str threads
 
 # Includes, packages and compiler
 
@@ -38,7 +38,7 @@ EXTLIB_INCLUDES=$(EXTLIB_LIBS:%=-I libs/%)
 ALL_INCLUDES=$(EXTLIB_INCLUDES) $(HAXE_INCLUDES)
 FINDLIB_PACKAGES=$(FINDLIB_LIBS:%=-package %)
 CFLAGS=
-ALL_CFLAGS=-bin-annot -g -w -3 $(CFLAGS) $(ALL_INCLUDES) $(FINDLIB_PACKAGES)
+ALL_CFLAGS=-bin-annot -thread -g -w -3 $(CFLAGS) $(ALL_INCLUDES) $(FINDLIB_PACKAGES)
 
 ifeq ($(BYTECODE),1)
 	TARGET_FLAG = bytecode
@@ -86,7 +86,7 @@ else
 	LIB_PARAMS?= -cclib -lpcre -cclib -lz
 endif
 
-NATIVE_LIBS=-cclib libs/extc/extc_stubs.o -cclib libs/extc/process_stubs.o -cclib libs/objsize/c_objsize.o -cclib libs/pcre/pcre_stubs.o -ccopt -L/usr/local/lib $(LIB_PARAMS)
+NATIVE_LIBS=-thread -cclib libs/extc/extc_stubs.o -cclib libs/extc/process_stubs.o -cclib libs/objsize/c_objsize.o -cclib libs/pcre/pcre_stubs.o -ccopt -L/usr/local/lib $(LIB_PARAMS)
 
 # Modules
 

+ 9 - 43
src/compiler/main.ml

@@ -169,55 +169,21 @@ let run_command ctx cmd =
 		if not Globals.is_windows then s else String.concat "\n" (Str.split (Str.regexp "\r\n") s)
 	in
 	let pout, pin, perr = Unix.open_process_full cmd (Unix.environment()) in
-	let iout = Unix.descr_of_in_channel pout in
-	let ierr = Unix.descr_of_in_channel perr in
-	let berr = Buffer.create 0 in
 	let bout = Buffer.create 0 in
-	let tmp = String.create 1024 in
-	let result = ref None in
-	(*
-		we need to read available content on process out/err if we want to prevent
-		the process from blocking when the pipe is full
-	*)
-	let is_process_running() =
-		let pid, r = Unix.waitpid [Unix.WNOHANG] (-1) in
-		if pid = 0 then
-			true
-		else begin
-			result := Some r;
-			false;
-		end
-	in
-	let rec loop ins =
-		let (ch,_,_), timeout = (try Unix.select ins [] [] 0.02, true with _ -> ([],[],[]),false) in
-		match ch with
-		| [] ->
-			(* make sure we read all *)
-			if timeout && is_process_running() then
-				loop ins
-			else begin
-				Buffer.add_string berr (IO.read_all (IO.input_channel perr));
-				Buffer.add_string bout (IO.read_all (IO.input_channel pout));
-			end
-		| s :: _ ->
-			let n = Unix.read s tmp 0 (String.length tmp) in
-			if s == iout && n > 0 then
-				ctx.com.print (String.sub tmp 0 n)
-			else
-				Buffer.add_substring (if s == iout then bout else berr) tmp 0 n;
-			loop (if n = 0 then List.filter ((!=) s) ins else ins)
+	let berr = Buffer.create 0 in
+	let read_content channel buf =
+		Buffer.add_string buf (IO.read_all (IO.input_channel channel));
 	in
-	(try loop [iout;ierr] with Unix.Unix_error _ -> ());
+	let tout = Thread.create (fun() -> read_content pout bout) () in
+	read_content perr berr;
+	Thread.join tout;
+	let result = (match Unix.close_process_full (pout,pin,perr) with Unix.WEXITED c | Unix.WSIGNALED c | Unix.WSTOPPED c -> c) in
 	let serr = binary_string (Buffer.contents berr) in
 	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;
-	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
+	if sout <> "" then ctx.com.print (sout ^ "\n");
 	t();
-	r
+	result
 
 module Initialize = struct
 	let set_platform com pf file =