浏览代码

update tests

Simon Krajewski 5 年之前
父节点
当前提交
9e77b24a8b

+ 3 - 3
src/context/typecore.ml

@@ -139,7 +139,7 @@ and typer = {
 }
 
 and monomorphs = {
-	mutable percall : tmono list;
+	mutable percall : (tmono * pos) list;
 	mutable perfunction : (tmono * pos) list;
 }
 
@@ -544,7 +544,7 @@ let spawn_constrained_monos ctx p map params =
 	let monos = List.map (fun (s,_) ->
 		let mono = Monomorph.create() in
 		(* if Meta.has (Meta.Custom ":debug.monomorphs") ctx.curfield.cf_meta then Monomorph.add_constraint mono "debug" p (MDebug s); *)
-		ctx.monomorphs.percall <- mono :: ctx.monomorphs.percall;
+		ctx.monomorphs.percall <- (mono,p) :: ctx.monomorphs.percall;
 		TMono mono
 	) params in
 	let map t = map (apply_params params monos t) in
@@ -563,7 +563,7 @@ let with_contextual_monos ctx f =
 	let old_monos = ctx.monomorphs.percall in
 	ctx.monomorphs.percall <- [];
 	let r = f() in
-	(* List.iter (fun m -> ignore(Monomorph.close m)) ctx.monomorphs; *)
+	(* List.iter (fun (m,p) -> ignore(safe_mono_close ctx m p)) ctx.monomorphs.percall; *)
 	ctx.monomorphs.percall <- old_monos;
 	r
 

+ 1 - 1
src/core/tUnification.ml

@@ -123,7 +123,7 @@ module Monomorph = struct
 
 	let rec bind m t =
 		begin match t with
-		| TAnon _ | TMono _ when List.exists (fun constr -> constr.mc_kind = MOpenStructure) m.tm_constraints ->
+		| TAnon _ when List.exists (fun constr -> constr.mc_kind = MOpenStructure) m.tm_constraints ->
 			(* If we assign an open structure monomorph to another structure, the semantics want us to merge the
 			   fields. This is kinda weird, but that's how it has always worked. *)
 			let fields = ExtList.List.filter_map (fun constr -> match constr.mc_kind with

+ 0 - 0
tests/misc/projects/Issue7997/compile-fail.hxml.disabled → tests/misc/projects/Issue7997/compile-fail.hxml


+ 2 - 2
tests/misc/projects/Issue7997/compile-fail.hxml.stderr

@@ -1,2 +1,2 @@
-Main.hx:5: characters 9-18 : {+ field : Unknown<0> } should be {+ args : {+ field : Unknown<0> } }
-Main.hx:5: characters 9-18 : For function argument 'type'
+Main.hx:4: characters 4-19 : Recursive type
+Main.hx:4: characters 4-19 : Unknown<0> appears in { args: Unknown<0> }

+ 17 - 0
tests/unit/src/unit/TestConstrainedMonomorphs.hx

@@ -0,0 +1,17 @@
+package unit;
+
+import utest.Assert;
+
+class TestConstrainedMonomorphs extends Test {
+
+	function infer(arg) {
+		var s1 = arg.toUpperCase();
+		var s:String = arg;
+		HelperMacros.typedAs(arg, "foo");
+		return s + s1;
+	}
+
+	function testNarrowingInference() {
+		eq("fooFOO", infer("foo"));
+	}
+}

+ 2 - 1
tests/unit/src/unit/TestMain.hx

@@ -109,7 +109,8 @@ function main() {
 		new TestMapComprehension(),
 		new TestMacro(),
 		new TestKeyValueIterator(),
-		new TestFieldVariance()
+		new TestFieldVariance(),
+		new TestConstrainedMonomorphs()
 		//new TestUnspecified(),
 		//new TestRemoting(),
 	];