Browse Source

[js] don't over-optimize (closes #7988) (#8027)

Dan Korostelev 6 years ago
parent
commit
6faa866f12
2 changed files with 43 additions and 10 deletions
  1. 22 10
      src/filters/ES6Ctors.ml
  2. 21 0
      tests/misc/es6/Test.hx

+ 22 - 10
src/filters/ES6Ctors.ml

@@ -39,9 +39,9 @@ let rec replace_super_call e =
 exception Accessed_this of texpr
 exception Accessed_this of texpr
 
 
 (* return whether given expression has `this` access before calling `super` *)
 (* return whether given expression has `this` access before calling `super` *)
-let has_this_before_super e = 
+let has_this_before_super e =
 	let rec loop e =
 	let rec loop e =
-		match e.eexpr with 
+		match e.eexpr with
 		| TCall ({ eexpr = TConst TSuper }, args) ->
 		| TCall ({ eexpr = TConst TSuper }, args) ->
 			List.iter loop args;
 			List.iter loop args;
 			raise Exit
 			raise Exit
@@ -56,6 +56,10 @@ let has_this_before_super e =
 		| Exit -> None
 		| Exit -> None
 		| Accessed_this e -> Some e
 		| Accessed_this e -> Some e
 
 
+let get_num_args cf =
+	match follow cf.cf_type with
+	| TFun (args, _) -> List.length args
+	| _ -> assert false
 
 
 (*
 (*
 	the filter works in two passes:
 	the filter works in two passes:
@@ -74,7 +78,7 @@ let rewrite_ctors com =
 		generate RootClass._hx_skip_constructor expressions
 		generate RootClass._hx_skip_constructor expressions
 	*)
 	*)
 	let mark_does_ctor_skipping cl cl_super p_this_access =
 	let mark_does_ctor_skipping cl cl_super p_this_access =
-		let rec mark_needs_ctor_skipping cl = 
+		let rec mark_needs_ctor_skipping cl =
 			(* for non haxe-generated extern classes we can't generate any valid code, so just fail *)
 			(* for non haxe-generated extern classes we can't generate any valid code, so just fail *)
 			if cl.cl_extern && not (Meta.has Meta.HxGen cl.cl_meta) then begin
 			if cl.cl_extern && not (Meta.has Meta.HxGen cl.cl_meta) then begin
 				abort "Must call `super()` constructor before accessing `this` in classes derived from an extern class with constructor" p_this_access;
 				abort "Must call `super()` constructor before accessing `this` in classes derived from an extern class with constructor" p_this_access;
@@ -84,8 +88,16 @@ let rewrite_ctors com =
 			with Not_found ->
 			with Not_found ->
 				let root =
 				let root =
 					match cl.cl_super with
 					match cl.cl_super with
-					| Some ({ cl_constructor = Some _ } as cl_super,_) -> mark_needs_ctor_skipping cl_super
-					| _ -> cl
+					| Some ({ cl_constructor = Some ctor_super } as cl_super,_) ->
+						let root = mark_needs_ctor_skipping cl_super in
+						Option.may (fun ctor ->
+							(* if parent's constructor receives less arguments than needed for this - we need to override the constructor *)
+							if get_num_args ctor > get_num_args ctor_super then
+								Hashtbl.add does_ctor_skipping cl.cl_path root;
+						) cl.cl_constructor;
+						root
+					| _ ->
+						cl
 				in
 				in
 				Hashtbl.add needs_ctor_skipping cl.cl_path root;
 				Hashtbl.add needs_ctor_skipping cl.cl_path root;
 				root
 				root
@@ -112,7 +124,7 @@ let rewrite_ctors com =
 				) this_before_super
 				) this_before_super
 			end else begin
 			end else begin
 				(* if there was no ctor in the parent class, we still gotta call `super` *)
 				(* if there was no ctor in the parent class, we still gotta call `super` *)
-				Hashtbl.add inject_super cl.cl_path cl; 
+				Hashtbl.add inject_super cl.cl_path cl;
 			end
 			end
 		| _ -> ()
 		| _ -> ()
 	in
 	in
@@ -120,7 +132,7 @@ let rewrite_ctors com =
 
 
 	if !activated then begin
 	if !activated then begin
 		(* just some helper common exprs *)
 		(* just some helper common exprs *)
-		let e_false = (make_bool com.basic false null_pos) in 
+		let e_false = (make_bool com.basic false null_pos) in
 		let e_true = (make_bool com.basic true null_pos) in
 		let e_true = (make_bool com.basic true null_pos) in
 		let e_hx_ctor = (* this._hx_constructor *)
 		let e_hx_ctor = (* this._hx_constructor *)
 			let ethis = mk (TConst TThis) t_dynamic null_pos  in
 			let ethis = mk (TConst TThis) t_dynamic null_pos  in
@@ -162,13 +174,13 @@ let rewrite_ctors com =
 				(match (try Some (Hashtbl.find needs_ctor_skipping cl.cl_path) with Not_found -> None) with
 				(match (try Some (Hashtbl.find needs_ctor_skipping cl.cl_path) with Not_found -> None) with
 				| Some root ->
 				| Some root ->
 					add_hx_ctor_method ();
 					add_hx_ctor_method ();
-					
+
 					if does_ctor_skipping = None && cl != root then
 					if does_ctor_skipping = None && cl != root then
 						(* for intermediate classes that support skipping but don't do skipping themselves, we can just remove the constructor altogether,
 						(* for intermediate classes that support skipping but don't do skipping themselves, we can just remove the constructor altogether,
 						because the skipping logic is implemented in the parent constructor, and the actual constructor body is moved into _hx_constructor *)
 						because the skipping logic is implemented in the parent constructor, and the actual constructor body is moved into _hx_constructor *)
 						cf_ctor.cf_expr <- None
 						cf_ctor.cf_expr <- None
 					else begin
 					else begin
-						let e_skip = 
+						let e_skip =
 							let e_return = (mk (TReturn None) t_dynamic null_pos) in
 							let e_return = (mk (TReturn None) t_dynamic null_pos) in
 							if cl.cl_super = None || (Hashtbl.mem inject_super cl.cl_path)  then
 							if cl.cl_super = None || (Hashtbl.mem inject_super cl.cl_path)  then
 								(* just `return` *)
 								(* just `return` *)
@@ -189,7 +201,7 @@ let rewrite_ctors com =
 								make_hx_ctor_call e_skip_flag
 								make_hx_ctor_call e_skip_flag
 							]
 							]
 						} in
 						} in
-						
+
 						cf_ctor.cf_expr <- Some { ctor_expr with eexpr = TFunction { tf_ctor with tf_expr = e_ctor_replaced } };
 						cf_ctor.cf_expr <- Some { ctor_expr with eexpr = TFunction { tf_ctor with tf_expr = e_ctor_replaced } };
 					end;
 					end;
 
 

+ 21 - 0
tests/misc/es6/Test.hx

@@ -49,6 +49,25 @@ class Child extends Base {
 	}
 	}
 }
 }
 
 
+class RootNoArgs {
+	public function new() {}
+}
+
+class ChildOneArg extends RootNoArgs {
+	public var x:Int;
+	public function new(x) {
+		super();
+		this.x = x;
+	}
+}
+
+class GrandChildNoArgs extends ChildOneArg {
+	public function new() {
+		Test.use(this);
+		super(42);
+	}
+}
+
 class Test {
 class Test {
 	public static var calls:Array<String>;
 	public static var calls:Array<String>;
 	@:pure(false) public static function use(v:Any) {}
 	@:pure(false) public static function use(v:Any) {}
@@ -128,6 +147,8 @@ class Test {
 		new Child();
 		new Child();
 		assert(calls.join("|") == "CHILD|BASE");
 		assert(calls.join("|") == "CHILD|BASE");
 
 
+		assert(new ChildOneArg(42).x == 42); // #7988
+
 		// ---
 		// ---
 
 
 		(untyped process).exit(if (failures == 0) 0 else 1);
 		(untyped process).exit(if (failures == 0) 0 else 1);