[hl] fix closure type when override dynamic function in generic class

src/generators/cpp/cppRetyper.ml

@@ -1890,8 +1890,8 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params =
           cpp_abort PromotedStackOnlyValueType field.cf_pos
         | _ ->
           Some (create_variable field))
-      (* Dynamic methods are implemented as a physical field holding a closure *)
-      | Method MethDynamic, Some { eexpr = TFunction func } ->
+      (* Dynamic methods are implemented as a physical field holding a closure, an overriding one shares the field of its parent *)
+      | Method MethDynamic, Some { eexpr = TFunction func } when not (is_override field) ->
         Some (create_dynamic_func_variable field func)
         (* Some (create_variable { field with cf_expr = None; cf_kind = Var ({ v_read = AccNormal; v_write = AccNormal }) }) *)
       (* Below should cause abstracts which have functions with no implementation to be generated as a field *)

src/generators/cpp/gen/cppGenClassHeader.ml

@@ -27,6 +27,7 @@ let gen_member_variable ctx is_static var =
       tcpp_str var.tcv_name tcpp_str get_ptr var.tcv_name |> output;)
 
 let gen_dynamic_function ctx class_def is_static func =
+  if func.tcf_is_overriding then () else
   let output    = ctx.ctx_output in
   let prefix    = if is_static then "\t\tstatic " else "\t\t" in
   let signature = func_to_callable_string "::hx::Callable" func in

src/generators/cpp/gen/cppGenClassImplementation.ml

@@ -204,12 +204,15 @@ let gen_init_function ctx output_cpp tcpp_class =
   | None ->
     ()
 
+let new_default_closure func obj =
+  Printf.sprintf "%s(new __default_%s(%s))" (func_to_callable_string "::hx::Callable" func) func.tcf_name obj
+
 let gen_dynamic_function_allocator ctx output_cpp tcpp_class =
   match tcpp_class.tcl_dynamic_functions with
   | [] -> ()
   | functions ->
     let mapper func =
-      Printf.sprintf "\tif (!_hx_obj->%s.mPtr) { _hx_obj->%s = new __default_%s(_hx_obj); }" func.tcf_name func.tcf_name func.tcf_name in
+      Printf.sprintf "\tif (!_hx_obj->%s.mPtr) { _hx_obj->%s = %s; }" func.tcf_name func.tcf_name (new_default_closure func "_hx_obj") in
     let rec folder acc class_def =
       if has_dynamic_member_functions class_def then
         let super_name = join_class_path_remap class_def.cl_path "::" ^ "_obj" in
@@ -554,7 +557,7 @@ let generate_managed_class base_ctx tcpp_class =
   (* Initialise non-static variables *)
   output_cpp (class_name ^ "::" ^ class_name ^ "()\n{\n");
   List.iter
-    (fun func -> output_cpp ("\t" ^ func.tcf_name ^ " = new __default_" ^ func.tcf_name ^ "(this);\n"))
+    (fun func -> output_cpp (Printf.sprintf "\t%s = %s;\n" func.tcf_name (new_default_closure func "this")))
     tcpp_class.tcl_dynamic_functions;
   output_cpp "}\n\n";
 
@@ -690,10 +693,8 @@ let generate_managed_class base_ctx tcpp_class =
       |> List.fold_right (print_property prop_printer) tcpp_class.tcl_properties
       |> List.fold_right (print_function fun_printer) tcpp_class.tcl_functions in
 
-    if List.length all_fields > 0 then (
-      dump_quick_field_test all_fields;
-      output_cpp "\treturn super::__Field(inName,inCallProp);\n}\n\n");
-    );
+    dump_quick_field_test all_fields;
+    output_cpp "\treturn super::__Field(inName,inCallProp);\n}\n\n");
 
   if has_tcpp_class_flag tcpp_class StaticGet then (
     Printf.sprintf "bool %s::__GetStatic(const ::String &inName, ::Dynamic &outValue, ::hx::PropertyAccess inCallProp)\n{\n" class_name |> output_cpp;

src/generators/genhl.ml

@@ -540,7 +540,9 @@ and field_type ctx f p =
 		let creal = resolve_class ctx c pl false in
 		let rec loop c =
 			try
-				PMap.find f.cf_name c.cl_fields
+				let cf = PMap.find f.cf_name c.cl_fields in
+				if cf.cf_kind = Method MethDynamic && has_class_field_flag cf CfOverride then raise Not_found;
+				cf
 			with Not_found ->
 				match c.cl_super with
 				| Some (csup,_) -> loop csup
@@ -3595,12 +3597,14 @@ let generate_member ctx c f =
 			List.iter (fun f ->
 				match f.cf_kind with
 				| Method MethDynamic ->
+					let fid, ft = (try get_index f.cf_name o with Not_found -> die "" __LOC__) in
+					let fr = alloc_tmp ctx ft in
+					op ctx (OGetThis (fr,fid));
+					let jnext = jump ctx (fun n -> OJNotNull (fr,n)) in
 					let r = alloc_tmp ctx (to_type ctx f.cf_type) in
-					let fid = (try fst (get_index f.cf_name o) with Not_found -> die "" __LOC__) in
-					op ctx (OGetThis (r,fid));
-					op ctx (OJNotNull (r,2));
 					op ctx (OInstanceClosure (r,alloc_fid ctx c f,0));
-					op ctx (OSetThis (fid,r));
+					op ctx (OSetThis (fid,cast_to ctx r ft f.cf_pos));
+					jnext();
 				| _ -> ()
 			) c.cl_ordered_fields;
 			ignore(eval_expr ctx ff.tf_expr);

src/generators/genjvm.ml

@@ -414,6 +414,13 @@ let is_interface_var_access c cf =
 		| Var _ | Method MethDynamic -> true
 		| _ -> false
 
+let rec dynamic_field_owner c cf =
+	match c.cl_super with
+	| Some (csup,_) when cf.cf_kind = Method MethDynamic && has_class_field_flag cf CfOverride ->
+		dynamic_field_owner csup (try PMap.find cf.cf_name csup.cl_fields with Not_found -> cf)
+	| _ ->
+		c
+
 let follow = Abstract.follow_with_abstracts
 
 class haxe_exception gctx (t : Type.t) =
@@ -872,6 +879,7 @@ class texpr_to_jvm
 			let vtobj = self#vtype e1.etype in
 			code#arraylength vtobj;
 		| FInstance(c,tl,cf) | FClosure(Some(c,tl),({cf_kind = Method MethDynamic} as cf)) when not (is_interface_var_access c cf) ->
+			let c = dynamic_field_owner c cf in
 			self#texpr rvalue_any e1;
 			jm#getfield c.cl_path cf.cf_name (self#vtype cf.cf_type);
 			cast();
@@ -930,6 +938,7 @@ class texpr_to_jvm
 			jm#cast jsig_cf;
 			jm#putstatic c.cl_path cf.cf_name jsig_cf;
 		| TField(e1,FInstance(c,tl,cf)) when not (is_interface_var_access c cf) ->
+			let c = dynamic_field_owner c cf in
 			self#texpr rvalue_any e1;
 			let jsig_cf = self#vtype cf.cf_type in
 			if ak <> AKNone then begin
@@ -2563,6 +2572,8 @@ class tclass_to_jvm gctx c = object(self)
 			OverloadResolution.resolve_instance_overload false map_type c cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl)
 		in
 		let if_method f cf = match cf.cf_kind with
+			| Method MethDynamic ->
+				()
 			| Method _ ->
 				f cf;
 				List.iter f cf.cf_overloads
@@ -2635,7 +2646,7 @@ class tclass_to_jvm gctx c = object(self)
 			load();
 			jm_empty_ctor#call_super_ctor ConstructInit jsig_empty
 		end;
-		if c.cl_constructor = None then begin
+		begin
 			let handler = new texpr_to_jvm gctx None jc jm_empty_ctor None in
 			DynArray.iter (fun e ->
 				handler#texpr RVoid e;
@@ -2702,9 +2713,6 @@ class tclass_to_jvm gctx c = object(self)
 			| SCNone ->
 				()
 			end;
-			DynArray.iter (fun e ->
-				handler#texpr RVoid e;
-			) delayed_field_inits;
 		| _ ->
 			()
 		end;
@@ -2753,6 +2761,16 @@ class tclass_to_jvm gctx c = object(self)
 		end;
 		AnnotationHandler.generate_annotations (jm :> JvmBuilder.base_builder) cf.cf_meta
 
+	method private add_field_init c cf e =
+		let tl = extract_param_types c.cl_params in
+		let ethis = mk (TConst TThis) (TInst(c,tl)) null_pos in
+		let efield = mk (TField(ethis,FInstance(c,tl,cf))) cf.cf_type null_pos in
+		let eop = mk (TBinop(OpAssign,efield,e)) cf.cf_type null_pos in
+		match cf.cf_kind with
+		(* a dynamic method default goes to <init>, where the most derived class assigns last *)
+		| Method MethDynamic -> DynArray.add delayed_field_inits eop
+		| _ -> DynArray.add field_inits eop
+
 	method generate_field gctx (jc : JvmClass.builder) c mtype cf =
 		let jsig = jsignature_of_type gctx cf.cf_type in
 		let flags = if Meta.has Meta.Private cf.cf_meta then [FdPrivate] else if Meta.has Meta.Protected cf.cf_meta then [FdProtected] else [FdPublic] in
@@ -2776,19 +2794,7 @@ class tclass_to_jvm gctx c = object(self)
 					default e;
 				end;
 			| Some e when mtype <> MStatic ->
-				let tl = extract_param_types c.cl_params in
-				let ethis = mk (TConst TThis) (TInst(c,tl)) null_pos in
-				let efield = mk (TField(ethis,FInstance(c,tl,cf))) cf.cf_type null_pos in
-				let eop = mk (TBinop(OpAssign,efield,e)) cf.cf_type null_pos in
-				begin match cf.cf_kind with
-					| Method MethDynamic ->
-						let enull = Texpr.Builder.make_null efield.etype null_pos in
-						let echeck = Texpr.Builder.binop OpEq efield enull gctx.gctx.basic.tbool null_pos in
-						let eif = mk (TIf(echeck,eop,None)) gctx.gctx.basic.tvoid null_pos in
-						DynArray.add delayed_field_inits eif
-					| _ ->
-						DynArray.add field_inits eop
-				end
+				self#add_field_init c cf e
 			| Some e ->
 				match e.eexpr with
 				| TConst ct ->
@@ -2842,7 +2848,10 @@ class tclass_to_jvm gctx c = object(self)
 					if not (has_class_field_flag cf CfExtern) && not (is_weird_abstract_field_without_expression) then self#generate_method gctx jc c mtype cf
 				) (cf :: List.filter (fun cf -> has_class_field_flag cf CfOverload) cf.cf_overloads)
 			| _ ->
-				if not (has_class_flag c CInterface) && is_physical_field cf then self#generate_field gctx jc c mtype cf
+				(* an overriding dynamic method has no field of its own, only a default value to install *)
+				if not (has_class_flag c CInterface) && is_physical_field cf then
+					if dynamic_field_owner c cf == c then self#generate_field gctx jc c mtype cf
+					else Option.may (self#add_field_init c cf) cf.cf_expr
 		in
 		let field mtype cf =
 			run_timed gctx true cf.cf_name (fun () -> field mtype cf)
@@ -2891,7 +2900,7 @@ class tclass_to_jvm gctx c = object(self)
 		end;
 		self#generate_signature;
 		if gctx.dynamic_level > 0 && not (Meta.has Meta.NativeGen c.cl_meta) && not (has_class_flag c CInterface) then
-			generate_dynamic_access gctx jc (List.map (fun cf -> cf.cf_name,jsignature_of_type gctx cf.cf_type,cf.cf_kind) c.cl_ordered_fields) false;
+			generate_dynamic_access gctx jc (List.map (fun cf -> cf.cf_name,jsignature_of_type gctx cf.cf_type,cf.cf_kind) (List.filter (fun cf -> dynamic_field_owner c cf == c) c.cl_ordered_fields)) false;
 		self#generate_annotations;
 		let jc = jc#export_class gctx.default_export_config in
 		write_class gctx c.cl_path jc

src/macro/eval/evalPrototype.ml

@@ -71,6 +71,8 @@ module PrototypeBuilder = struct
 		fields : (int * value AtomicLazy.t) DynArray.t;
 		(* The instance fields of the prototype. See above. *)
 		instance_fields : (int * value AtomicLazy.t) DynArray.t;
+		(* Initial values replacing the ones of an inherited instance field, instead of adding a new one. *)
+		instance_field_overrides : (int * value AtomicLazy.t) DynArray.t;
 		(* The metadata expression, if exists. *)
 		meta : texpr option;
 		(* Whether or not the prototype is static. *)
@@ -87,6 +89,7 @@ module PrototypeBuilder = struct
 			kind = kind;
 			fields = DynArray.create ();
 			instance_fields = DynArray.create ();
+			instance_field_overrides = DynArray.create ();
 			meta = meta;
 			is_static = is_static;
 		}
@@ -99,6 +102,10 @@ module PrototypeBuilder = struct
 	let add_instance_field pctx name v =
 		DynArray.add pctx.instance_fields (name,v)
 
+	(* Changes the initial value of an inherited instance field, keeping its offset. *)
+	let override_instance_field pctx name v =
+		DynArray.add pctx.instance_field_overrides (name,v)
+
 	(* Forces the lazy field values and assigns them to the prototype. *)
 	let initialize_fields pctx proto =
 		DynArray.iteri (fun i (_,v) -> proto.pfields.(i) <- AtomicLazy.force v) pctx.fields
@@ -138,6 +145,10 @@ module PrototypeBuilder = struct
 			names,a,(fun proto ->
 				Array.iteri (fun i v -> a.(i) <- v) fields;
 				DynArray.iteri (fun i (_,v) -> a.(i + offset) <- AtomicLazy.force v) pctx.instance_fields;
+				DynArray.iter (fun (name,v) -> match IntMap.find_opt name names with
+					| Some i -> a.(i) <- AtomicLazy.force v
+					| None -> ()
+				) pctx.instance_field_overrides;
 				initialize_fields pctx proto;
 			)
 		end else
@@ -273,7 +284,10 @@ let create_instance_prototype ctx c =
 		| Method meth,Some {eexpr = TFunction tf; epos = pos} ->
 			let name = hash cf.cf_name in
 			let v = AtomicLazy.from_fun (fun () -> vfunction (jit_tfunction ctx key name tf false pos)) in
-			if meth = MethDynamic then PrototypeBuilder.add_instance_field pctx name v;
+			(* an overriding dynamic method only changes the initial value of the parent's field *)
+			if meth = MethDynamic then
+				if has_class_field_flag cf CfOverride then PrototypeBuilder.override_instance_field pctx name v
+				else PrototypeBuilder.add_instance_field pctx name v;
 			PrototypeBuilder.add_proto_field pctx name v
 		| Var _,_ when is_physical_field cf ->
 			let name = hash cf.cf_name in