Merge pull request #2911 from Simn/abstract-fixes

Abstract fixes

codegen.ml

@@ -681,53 +681,45 @@ module Abstract = struct
 		make_static_call ctx c cf (apply_params a.a_types pl) args t p
 
 	let rec do_check_cast ctx tleft eright p =
-		let tright = follow eright.etype in
-		let tleft = follow tleft in
-		if tleft == tright then eright else
 		let recurse cf f =
 			if cf == ctx.curfield || List.mem cf !cast_stack then error "Recursive implicit cast" p;
 			cast_stack := cf :: !cast_stack;
 			let r = f() in
 			cast_stack := List.tl !cast_stack;
 			r
 		in
-		try (match tright,tleft with
-			| (TAbstract({a_impl = Some c1} as a1,pl1) as t1),(TAbstract({a_impl = Some c2} as a2,pl2) as t2) ->
-				if a1 == a2 then
-					eright
-				else begin
-					let c,cfo,a,pl = try
-						if Meta.has Meta.MultiType a1.a_meta then raise Not_found;
-						c1,snd (find_to a1 pl1 t2),a1,pl1
-					with Not_found ->
-						if Meta.has Meta.MultiType a2.a_meta then raise Not_found;
-						c2,snd (find_from a2 pl2 t1 t2),a2,pl2
-					in
-					match cfo with
-					| None -> eright
-					| Some cf ->
-						recurse cf (fun () -> make_static_call ctx c cf a pl [eright] tleft p)
-				end
-			| _, TMono _ | TMono _, _ ->
-				eright
-			| TAbstract({a_impl = Some c} as a,pl),t2 when not (Meta.has Meta.MultiType a.a_meta) ->
-				begin match find_to a pl t2 with
-					| tcf,None ->
-						let tcf = apply_params a.a_types pl tcf in
-						if type_iseq tcf tleft then eright else do_check_cast ctx tcf eright p
-					| _,Some cf ->
-						recurse cf (fun () -> make_static_call ctx c cf a pl [eright] tleft p)
-				end
-			| t1,(TAbstract({a_impl = Some c} as a,pl) as t2) when not (Meta.has Meta.MultiType a.a_meta) ->
-				begin match find_from a pl t1 t2 with
-					| tcf,None ->
-						let tcf = apply_params a.a_types pl tcf in
-						if type_iseq tcf tleft then eright else do_check_cast ctx tcf eright p
-					| _,Some cf ->
-						recurse cf (fun () -> make_static_call ctx c cf a pl [eright] tleft p)
-				end
-			| _ ->
-				eright)
+		let find a tl f =
+			let tcf,cfo = f() in
+			match cfo,a.a_impl with
+				| None,_ ->
+					let tcf = apply_params a.a_types tl tcf in
+					if type_iseq tcf tleft then
+						eright
+					else
+						(* TODO: causes Java overload issues *)
+						(* let eright = mk (TCast(eright,None)) tleft p in *)
+						do_check_cast ctx tcf eright p
+				| Some cf,Some c ->
+					recurse cf (fun () -> make_static_call ctx c cf a tl [eright] tleft p)
+				| _ ->
+					assert false
+		in
+		if type_iseq tleft eright.etype then
+			eright
+		else try
+			begin match follow eright.etype with
+				| TAbstract(a,tl) ->
+					find a tl (fun () -> find_to a tl tleft)
+				| _ ->
+					raise Not_found
+			end
+		with Not_found -> try
+			begin match follow tleft with
+				| TAbstract(a,tl) ->
+					find a tl (fun () -> find_from a tl eright.etype tleft)
+				| _ ->
+					raise Not_found
+			end
 		with Not_found ->
 			eright
 

std/Map.hx

@@ -150,15 +150,15 @@ abstract Map<K,V>(IMap<K,V> ) {
 	}
 
 	@:from static inline function fromStringMap<V>(map:StringMap<V>):Map< String, V > {
-		return map;
+		return cast map;
 	}
 
 	@:from static inline function fromIntMap<V>(map:IntMap<V>):Map< Int, V > {
-		return map;
+		return cast map;
 	}
 
 	@:from static inline function fromObjectMap<K:{ }, V>(map:ObjectMap<K,V>):Map<K,V> {
-		return map;
+		return cast map;
 	}
 }
 

tests/unit/issues/Issue2871.hx

@@ -1,7 +1,6 @@
 package unit.issues;
 
 class Issue2871 extends Test {
-	#if !java
     function call(myUInt:Null<UInt> = null):Int {
         return myUInt == null ? 0 : myUInt;
     }
@@ -10,5 +9,4 @@ class Issue2871 extends Test {
 		eq(0, call(null));
 		eq(1, call((1:UInt)));
 	}
-	#end
 }

typer.ml

@@ -161,26 +161,35 @@ let rec is_pos_infos = function
 	| _ ->
 		false
 
-let check_constraints ctx tname tpl tl map p =
+let check_constraints ctx tname tpl tl map delayed p =
 	List.iter2 (fun m (name,t) ->
 		match follow t with
 		| TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
-			delay ctx PCheckConstraint (fun() ->
+			let f = (fun() ->
 				List.iter (fun ct ->
 					try
 						Type.unify (map m) (map ct)
 					with Unify_error l ->
-						display_error ctx (error_msg (Unify (Constraint_failure (tname ^ "." ^ name) :: l))) p;
+						let l = Constraint_failure (tname ^ "." ^ name) :: l in
+						raise (Unify_error l)
 				) constr
-			);
+			) in
+			if delayed then
+				delay ctx PCheckConstraint f
+			else
+				f()
 		| _ ->
 			()
 	) tl tpl
 
 let enum_field_type ctx en ef tl_en tl_ef p =
 	let map t = apply_params en.e_types tl_en (apply_params ef.ef_params tl_ef t) in
-	check_constraints ctx (s_type_path en.e_path) en.e_types tl_en map p;
-	check_constraints ctx ef.ef_name ef.ef_params tl_ef map p;
+	begin try
+		check_constraints ctx (s_type_path en.e_path) en.e_types tl_en map true p;
+		check_constraints ctx ef.ef_name ef.ef_params tl_ef map true p;
+	with Unify_error l ->
+		display_error ctx (error_msg (Unify l)) p
+	end;
 	map ef.ef_type
 
 let add_constraint_checks ctx ctypes pl f tl p =
@@ -1834,7 +1843,8 @@ let rec type_binop ctx op e1 e2 is_assign_op p =
 			| [] -> raise Not_found
 			| (o,cf) :: ops when is_assign_op && o = OpAssignOp(op) || o == op ->
 				let impl = Meta.has Meta.Impl cf.cf_meta in
-				let tcf = monomorphs cf.cf_params cf.cf_type in
+				let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+				let tcf = apply_params cf.cf_params monos cf.cf_type in
 				let tcf = if impl then apply_params a.a_types pl tcf else tcf in
 				(match follow tcf with
 				| TFun([(_,_,t1);(_,_,t2)],r) ->
@@ -1848,7 +1858,16 @@ let rec type_binop ctx op e1 e2 is_assign_op p =
 								else
 									type_eq EqStrict (TAbstract(a,pl)) t1;
 							end;
+							(* special case for == and !=: if the second type is a monomorph, assume that we want to unify
+							   it with the first type to preserve comparison semantics. *)
+							begin match op,follow t with
+								| (OpEq | OpNotEq),TMono _ ->
+									Type.unify (if left then e1.etype else e2.etype) t
+								| _ ->
+									()
+							end;
 							Type.unify t t2;
+							check_constraints ctx "" cf.cf_params monos (apply_params a.a_types pl) false cf.cf_pos;
 							cf,t2,r,o = OpAssignOp(op),Meta.has Meta.Commutative cf.cf_meta
 						with Unify_error _ ->
 							loop ops