handle implicit casts for abstract constructor arguments (fixed issue H…

…axeFoundation#1710)

codegen.ml

@@ -1402,6 +1402,12 @@ module Abstract = struct
 		with Not_found ->
 			eright
 
+	and call_args ctx el tl = match el,tl with
+		| [],_ -> []
+		| e :: el, [] -> (loop ctx e) :: call_args ctx el []
+		| e :: el, (_,_,t) :: tl ->
+			(check_cast ctx t (loop ctx e) e.epos) :: call_args ctx el tl
+
 	and loop ctx e = match e.eexpr with
 		| TBinop(OpAssign,e1,e2) ->
 			let e2 = check_cast ctx e1.etype (loop ctx e2) e.epos in
@@ -1437,6 +1443,19 @@ module Abstract = struct
 				let e = make_static_call ctx c cf a pl ((mk (TConst TNull) at e.epos) :: el) m e.epos in
 				{e with etype = m}
 			end
+		| TNew(c,pl,el) ->
+			begin try
+				let t,_ = (!get_constructor_ref) ctx c pl e.epos in
+				begin match follow t with
+					| TFun(args,_) ->
+						{ e with eexpr = TNew(c,pl,call_args ctx el args)}
+					| _ ->
+						Type.map_expr (loop ctx) e
+				end
+			with Error _ ->
+				(* TODO: when does this happen? *)
+				Type.map_expr (loop ctx) e
+			end
 		| TCall(e1, el) ->
 			let e1 = loop ctx e1 in
 			begin try
@@ -1469,14 +1488,7 @@ module Abstract = struct
 			with Not_found ->
 				begin match follow e1.etype with
 					| TFun(args,_) ->
-						let rec loop2 el tl = match el,tl with
-							| [],_ -> []
-							| e :: el, [] -> (loop ctx e) :: loop2 el []
-							| e :: el, (_,_,t) :: tl ->
-								(check_cast ctx t (loop ctx e) e.epos) :: loop2 el tl
-						in
-						let el = loop2 el args in
-						{ e with eexpr = TCall(loop ctx e1,el)}
+						{ e with eexpr = TCall(loop ctx e1,call_args ctx el args)}
 					| _ ->
 						Type.map_expr (loop ctx) e
 				end

tests/unit/MyAbstract.hx

@@ -57,6 +57,14 @@ abstract Kilometer(Float) from Float to Float {
 		return new Kilometer(m.get() / 1000.);
 }
 
+
+class MyClassWithAbstractArgCtor {
+	public var km:Kilometer;
+	public function new(km:Kilometer) {
+		this.km = km;
+	}
+}
+
 abstract MyHash<V>(haxe.ds.StringMap<V>) {
 	private inline function new() {
 		this = new haxe.ds.StringMap<V>();

tests/unit/TestBasetypes.hx

@@ -394,6 +394,11 @@ class TestBasetypes extends Test {
 
 		eq(switchMe(true), "12.2m");
 		eq(switchMe(false), "2.4m");
+
+		// ctor
+		var m:unit.MyAbstract.Meter = 3000;
+		var c = new unit.MyAbstract.MyClassWithAbstractArgCtor(m);
+		feq(c.km, 3);
 	}
 
 	function testAbstractToAbstractCast() {

typecore.ml

@@ -139,6 +139,7 @@ let type_expr_ref : (typer -> Ast.expr -> with_type -> texpr) ref = ref (fun _ _
 let unify_min_ref : (typer -> texpr list -> t) ref = ref (fun _ _ -> assert false)
 let match_expr_ref : (typer -> Ast.expr -> (Ast.expr list * Ast.expr option * Ast.expr option) list -> Ast.expr option option -> with_type -> Ast.pos -> texpr) ref = ref (fun _ _ _ _ _ _ -> assert false)
 let get_pattern_locals_ref : (typer -> Ast.expr -> Type.t -> (string, tvar) PMap.t) ref = ref (fun _ _ _ -> assert false)
+let get_constructor_ref : (typer -> tclass -> t list -> Ast.pos -> (t * tclass_field)) ref = ref (fun _ _ _ _ -> assert false)
 
 (* Source: http://en.wikibooks.org/wiki/Algorithm_implementation/Strings/Levenshtein_distance#OCaml *)
 let levenshtein a b =

typer.ml

@@ -114,7 +114,7 @@ let get_iterator_param t =
 			raise Not_found)
 	| _ ->
 		raise Not_found
-	
+
 let get_iterable_param t =
 	match follow t with
 	| TAnon a ->
@@ -155,7 +155,7 @@ let remove_constant_flag t callb =
 	with e ->
 		restore();
 		raise e
-			
+
 let rec is_pos_infos = function
 	| TMono r ->
 		(match !r with
@@ -4069,3 +4069,4 @@ let rec create com =
 ;;
 unify_min_ref := unify_min;
 make_call_ref := make_call;
+get_constructor_ref := get_constructor;