Add some thread tests (and fix eval) (#7992)

* keep track of who owns a mutex

* factor out and fix Deque

* use a proper Deque for thread messaging

* turns out readMessage is actually static

* try to run some threads tests

* casing is important you dirty Windows peasant

* add Deque test

* disable Deque test for Java

* allow lock timeout

* use less threads because AppVeyor chokes

* don't run thread tests for now

.gitignore

@@ -121,3 +121,4 @@ tests/benchs/export/
 tests/benchs/dump/
 tests/display/.unittest/
 tests/unit/.unittest/
+tests/threads/export/

src/macro/eval/evalDebugSocket.ml

@@ -96,8 +96,12 @@ let var_to_json name value vio env =
 		| VVector vv -> jv "Vector" (array_elems (Array.to_list vv)) (Array.length vv)
 		| VInstance vi ->
 			let class_name = EvalDebugMisc.safe_call env.env_eval EvalPrinting.value_string v in
-			let fields = instance_fields vi in
-			jv class_name (class_name) (List.length fields)
+			let num_children = match vi.ikind with
+			| IMutex _ -> 1
+			| IThread _ -> 1
+			| _ -> List.length (instance_fields vi)
+			in
+			jv class_name (class_name) num_children
 		| VPrototype proto ->
 			let fields = proto_fields proto in
 			jv "Anonymous" (s_proto_kind proto).sstring (List.length fields)
@@ -148,7 +152,7 @@ let output_threads ctx =
 	let fold id eval acc =
 		(JObject [
 			"id",JInt id;
-			"name",JString eval.thread.tname
+			"name",JString (Printf.sprintf "Thread %i" (Thread.id eval.thread.tthread));
 		]) :: acc
 	in
 	let threads = IntMap.fold fold ctx.evals [] in
@@ -266,6 +270,10 @@ let output_inner_vars v env =
 			StringHashtbl.fold (fun s (_,v) acc ->
 				(s,v) :: acc
 			) h []
+		| VInstance {ikind = IMutex mutex} ->
+			["owner",match mutex.mowner with None -> vnull | Some id -> vint id]
+		| VInstance {ikind = IThread thread} ->
+			["id",vint (Thread.id thread.tthread)]
 		| VInstance vi ->
 			let fields = instance_fields vi in
 			List.map (fun (n,v) ->

src/macro/eval/evalMain.ml

@@ -102,11 +102,9 @@ let create com api is_macro =
 	let eval = {
 		env = null_env;
 		thread = {
-			tname = "mainThread";
 			tthread = Thread.self();
-			tchannel = Event.new_channel();
-			tqueue = Queue.create ();
 			tstorage = IntMap.empty;
+			tdeque = EvalStdLib.Deque.create();
 		};
 		debug_channel = Event.new_channel ();
 		debug_state = DbgRunning;

src/macro/eval/evalStdLib.ml

@@ -54,6 +54,45 @@ let encode_i64_direct i64 =
 	let high = Int64.to_int32 (Int64.shift_right_logical i64 32) in
 	encode_i64 low high
 
+module Deque = struct
+	let create () = {
+		dvalues = [];
+		dmutex = Mutex.create();
+	}
+
+	let add this i =
+		Mutex.lock this.dmutex;
+		this.dvalues <- this.dvalues @ [i];
+		Mutex.unlock this.dmutex;
+		vnull
+
+	let pop this blocking =
+		let rec loop () =
+			Mutex.lock this.dmutex;
+			match this.dvalues with
+			| v :: vl ->
+				this.dvalues <- vl;
+				Mutex.unlock this.dmutex;
+				v
+			| [] ->
+				if not blocking then begin
+					Mutex.unlock this.dmutex;
+					vnull
+				end else begin
+					Mutex.unlock this.dmutex;
+					Thread.yield();
+					loop()
+				end
+		in
+		loop()
+
+	let push this i =
+		Mutex.lock this.dmutex;
+		this.dvalues <- i :: this.dvalues;
+		Mutex.unlock this.dmutex;
+		vnull
+end
+
 
 module StdEvalVector = struct
 	let this this = match this with
@@ -740,46 +779,20 @@ module StdDeque = struct
 		| VInstance {ikind = IDeque d} -> d
 		| _ -> unexpected_value vthis "Deque"
 
-	let lock_mutex = Mutex.create ()
-
 	let add = vifun1 (fun vthis i ->
 		let this = this vthis in
-		Mutex.lock lock_mutex;
-		this.dvalues <- this.dvalues @ [i];
-		ignore(Event.poll(Event.send this.dchannel i));
-		Mutex.unlock lock_mutex;
-		vnull;
+		Deque.add this i
 	)
 
 	let pop = vifun1 (fun vthis blocking ->
 		let this = this vthis in
-		let rec loop () =
-			Mutex.lock lock_mutex;
-			match this.dvalues with
-			| v :: vl ->
-				this.dvalues <- vl;
-				Mutex.unlock lock_mutex;
-				v
-			| [] ->
-				if blocking <> VTrue then begin
-					Mutex.unlock lock_mutex;
-					vnull
-				end else begin
-					Mutex.unlock lock_mutex;
-					ignore(Event.sync(Event.receive this.dchannel));
-					loop()
-				end
-		in
-		loop()
+		let blocking = decode_bool blocking in
+		Deque.pop this blocking
 	)
 
 	let push = vifun1 (fun vthis i ->
 		let this = this vthis in
-		Mutex.lock lock_mutex;
-		this.dvalues <- i :: this.dvalues;
-		ignore(Event.poll(Event.send this.dchannel i));
-		Mutex.unlock lock_mutex;
-		vnull;
+		Deque.push this i
 	)
 end
 
@@ -1729,19 +1742,25 @@ module StdMutex = struct
 
 	let acquire = vifun0 (fun vthis ->
 		let mutex = this vthis in
-		Mutex.lock mutex;
+		Mutex.lock mutex.mmutex;
+		mutex.mowner <- Some (Thread.id (Thread.self()));
 		vnull
 	)
 
 	let release = vifun0 (fun vthis ->
 		let mutex = this vthis in
-		Mutex.unlock mutex;
+		mutex.mowner <- None;
+		Mutex.unlock mutex.mmutex;
 		vnull
 	)
 
 	let tryAcquire = vifun0 (fun vthis ->
 		let mutex = this vthis in
-		vbool (Mutex.try_lock mutex)
+		if Mutex.try_lock mutex.mmutex then begin
+			mutex.mowner <- Some (Thread.id (Thread.self()));
+			vtrue
+		end else
+			vfalse
 	)
 end
 
@@ -2664,24 +2683,15 @@ module StdThread = struct
 		encode_instance key_eval_vm_Thread ~kind:(IThread eval.thread)
 	)
 
-	let readMessage = vifun1 (fun vthis blocking ->
-		let this = this vthis in
-		if not (Queue.is_empty this.tqueue) then
-			Queue.pop this.tqueue
-		else if blocking <> VTrue then
-			vnull
-		else begin
-			let event = Event.receive this.tchannel in
-			ignore(Event.sync event);
-			Queue.pop this.tqueue
-		end
+	let readMessage = vfun1 (fun blocking ->
+		let eval = get_eval (get_ctx()) in
+		let blocking = decode_bool blocking in
+		Deque.pop eval.thread.tdeque blocking
 	)
 
 	let sendMessage = vifun1 (fun vthis msg ->
 		let this = this vthis in
-		Queue.add msg this.tqueue;
-		ignore(Event.poll (Event.send this.tchannel msg));
-		vnull
+		Deque.push this.tdeque msg
 	)
 
 	let yield = vfun0 (fun () ->
@@ -3206,22 +3216,22 @@ let init_constructors builtins =
 						close();
 						raise exc
 				in
-				let eval = get_eval ctx in
-				let name = kind_name eval eval.env.env_info.kind in
 				let thread = {
-					tname = name;
 					tthread = Obj.magic ();
-					tchannel = Event.new_channel ();
-					tqueue = Queue.create ();
 					tstorage = IntMap.empty;
+					tdeque = Deque.create();
 				} in
 				thread.tthread <- Thread.create f thread;
 				encode_instance key_eval_vm_Thread ~kind:(IThread thread)
 			| _ -> assert false
 		);
 	add key_eval_vm_Mutex
 		(fun _ ->
-			encode_instance key_eval_vm_Mutex ~kind:(IMutex (Mutex.create ()))
+			let mutex = {
+				mmutex = Mutex.create();
+				mowner = None;
+			} in
+			encode_instance key_eval_vm_Mutex ~kind:(IMutex mutex)
 		);
 	add key_eval_vm_Lock
 		(fun _ ->
@@ -3240,11 +3250,7 @@ let init_constructors builtins =
 		);
 	add key_eval_vm_Deque
 		(fun _ ->
-			let deque = {
-				dvalues = [];
-				dchannel = Event.new_channel();
-			} in
-			encode_instance key_eval_vm_Deque ~kind:(IDeque deque)
+			encode_instance key_eval_vm_Deque ~kind:(IDeque (Deque.create()))
 		)
 
 let init_empty_constructors builtins =
@@ -3616,12 +3622,12 @@ let init_standard_library builtins =
 		"delay",StdThread.delay;
 		"exit",StdThread.exit;
 		"join",StdThread.join;
+		"readMessage",StdThread.readMessage;
 		"self",StdThread.self;
 		"yield",StdThread.yield;
 	] [
 		"id",StdThread.id;
 		"kill",StdThread.kill;
-		"readMessage",StdThread.readMessage;
 		"sendMessage",StdThread.sendMessage;
 	];
 	init_fields builtins (["eval";"vm"],"Tls") [] [

src/macro/eval/evalValue.ml

@@ -155,7 +155,7 @@ and vinstance_kind =
 	| IOutChannel of out_channel (* FileOutput *)
 	| ISocket of Unix.file_descr
 	| IThread of vthread
-	| IMutex of Mutex.t
+	| IMutex of vmutex
 	| ILock of vlock
 	| ITls of int
 	| IDeque of vdeque
@@ -192,16 +192,19 @@ and venum_value = {
 }
 
 and vthread = {
-	tname : string;
 	mutable tthread : Thread.t;
-	tchannel : value Event.channel;
-	tqueue : value Queue.t;
+	tdeque : vdeque;
 	mutable tstorage : value IntMap.t;
 }
 
 and vdeque = {
 	mutable dvalues : value list;
-	dchannel : value Event.channel;
+	dmutex : Mutex.t;
+}
+
+and vmutex = {
+	mmutex : Mutex.t;
+	mutable mowner : int option; (* thread ID *)
 }
 
 and vlock = {

std/eval/vm/Thread.hx

@@ -19,6 +19,7 @@
  * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  * DEALINGS IN THE SOFTWARE.
  */
+
 package eval.vm;
 
 /**
@@ -33,7 +34,7 @@ extern class Thread {
 		Exceptions caused while executing `f` are printed to stderr and are not
 		propagated to the parent thread.
 	**/
-	function new(f:Void -> Void):Void;
+	function new(f:Void->Void):Void;
 
 	/**
 		Return the identifier of the given thread. A thread identifier is an integer
@@ -76,12 +77,11 @@ extern class Thread {
 		to other threads.
 	**/
 	static function yield():Void;
-
 	// neko API
-
-	function readMessage<T>(block:Bool):T;
+	static function readMessage<T>(block:Bool):T;
 	function sendMessage<T>(msg:T):Void;
-
-	static inline function create(f:Void -> Void):Thread return new Thread(f);
-	static inline function current():Thread return self();
-}
+	static inline function create(f:Void->Void):Thread
+		return new Thread(f);
+	static inline function current():Thread
+		return self();
+}

tests/runci/Config.hx

@@ -19,6 +19,7 @@ class Config {
 	static public final serverDir = cwd + "server/";
 	static public final sourcemapsDir = cwd + "sourcemaps/";
 	static public final nullSafetyDir = cwd + "nullsafety/";
+	static public final threadsDir = cwd + "threads/";
 
 	static public final ci:Null<Ci> =
 		if (Sys.getEnv("TRAVIS") == "true")

tests/runci/targets/Cpp.hx

@@ -68,6 +68,10 @@ class Cpp {
 		runCommand("haxe", ["compile-cpp.hxml"]);
 		runCpp("bin/cpp/Main-debug", []);
 
+		// changeDirectory(threadsDir);
+		// runCommand("haxe", ["build.hxml", "-cpp", "export/cpp"]);
+		// runCpp("export/cpp/Main");
+
 		// if (Sys.systemName() == "Mac")
 		// {
 		// 	changeDirectory(miscDir + "cppObjc");

tests/runci/targets/Hl.hx

@@ -44,7 +44,7 @@ class Hl {
         runCommand("cmake", [
             "--build", hlBuild
         ]);
-        
+
         addToPATH(Path.join([hlBuild, "bin"]));
         runCommand("hl", ["--version"]);
     }
@@ -54,6 +54,10 @@ class Hl {
         runCommand("haxe", ["compile-hl.hxml"].concat(args));
         runCommand("hl", ["bin/unit.hl"]);
 
+		// changeDirectory(threadsDir);
+		// runCommand("haxe", ["build.hxml", "-hl", "export/threads.hl"]);
+		// runCommand("hl", ["export/threads.hl"]);
+
         // TODO sys test
     }
 }

tests/runci/targets/Java.hx

@@ -23,6 +23,10 @@ class Java {
 		runCommand("haxe", ["compile-java.hxml"]);
 		runCommand("java", ["-jar", "bin/java/Main-Debug.jar"]);
 
+		// changeDirectory(threadsDir);
+		// runCommand("haxe", ["build.hxml", "-java", "export/java"]);
+		// runCommand("java", ["-jar", "export/java/Main.jar"]);
+
 		infoMsg("Testing java-lib extras");
 		changeDirectory('$unitDir/bin');
 		runCommand("git", ["clone", "https://github.com/waneck/java-lib-tests.git", "--depth", "1"], true);

tests/runci/targets/Macro.hx

@@ -31,5 +31,8 @@ class Macro {
 		changeDirectory(sysDir);
 		runCommand("haxe", ["compile-macro.hxml"]);
 		runCommand("haxe", ["compile-each.hxml", "--run", "Main"]);
+
+		// changeDirectory(threadsDir);
+		// runCommand("haxe", ["build.hxml", "--interp"]);
 	}
 }