Update anons with `a_status = Const` upon unification with `TAnon` with optional fields (#10507)

* add missing optional fields to anons with a_status = Const if needed (closes #10504)

* [python] don't generate missing optional fields

* [jvm] rewrite TObjectDecl mess

Co-authored-by: Simon Krajewski <[email protected]>

src/core/tUnification.ml

@@ -912,7 +912,7 @@ and unify_anons uctx a b a1 a2 =
 			Not_found ->
 				match !(a1.a_status) with
 				| Const when Meta.has Meta.Optional f2.cf_meta ->
-					()
+					a1.a_fields <- PMap.add f2.cf_name f2 a1.a_fields
 				| _ ->
 					error [has_no_field a n];
 		) a2.a_fields;

src/generators/genjvm.ml

@@ -2059,50 +2059,48 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 				jm#set_terminated true
 			end
 		| TObjectDecl fl ->
-			let td = gctx.anon_identification#identify true e.etype in
-			begin match follow e.etype,td with
-			(* The guard is here because in the case of quoted fields like `"a-b"`, the field is not part of the
-			   type. In this case we have to do full dynamic construction. *)
-			| TAnon an,Some pfm when List.for_all (fun ((name,_,_),_) -> PMap.mem name an.a_fields) fl ->
-				let fl' = convert_fields gctx pfm in
+			(* We cannot rely on e.etype because it might have optional field shit, so we need to build a concrete type from the fields... *)
+			let fields = List.fold_left (fun acc ((name,_,_),e) ->
+				let cf = mk_field name e.etype e.epos e.epos in
+				PMap.add name cf acc
+			) PMap.empty fl in
+			let t = mk_anon ~fields (ref Closed) in
+			let td = gctx.anon_identification#identify true t in
+			begin match td with
+			| Some pfm ->
+				let lut = Hashtbl.create 0 in
 				jm#construct ConstructInit pfm.pfm_path (fun () ->
-					(* We have to respect declaration order, so let's temp var where necessary *)
-					let rec loop fl fl' ok acc = match fl,fl' with
-						| ((name,_,_),e) :: fl,(name',jsig) :: fl' ->
-							if ok && name = name' then begin
+					(* Step 1: Expressions in order with temp vars *)
+					let rec loop fl = match fl with
+						| ((name,_,_),e) :: fl ->
+							let jsig = self#vtype e.etype in
+							let load = match (Texpr.skip e).eexpr with
+							| TConst _ | TTypeExpr _ | TFunction _ ->
+								(fun () -> self#texpr rvalue_any e)
+							| _ ->
+								let _,load,save = jm#add_local (Printf.sprintf "_hx_tmp_%s" name) jsig VarWillInit in
 								self#texpr rvalue_any e;
-								jm#cast jsig;
-								loop fl fl' ok acc
-							end else begin
-								let load = match (Texpr.skip e).eexpr with
-								| TConst _ | TTypeExpr _ | TFunction _ ->
-									(fun () -> self#texpr rvalue_any e)
-								| _ ->
-									let _,load,save = jm#add_local (Printf.sprintf "_hx_tmp_%s" name) (self#vtype e.etype) VarWillInit in
-									self#texpr rvalue_any e;
-									save();
-									load
-								in
-								loop fl fl' false ((name,load) :: acc)
-							end
-						| [],[] ->
-							acc
-						| (_,e) :: fl,[] ->
-							self#texpr RVoid e;
-							loop fl fl' ok acc
-						| [],(_,jsig) :: fl' ->
-							jm#load_default_value jsig;
-							loop [] fl' ok acc
+								save();
+								load
+							in
+							Hashtbl.add lut name load;
+							loop fl;
+						| [] ->
+							()
 					in
-					let vars = loop fl fl' true [] in
-					let vars = List.sort (fun (name1,_) (name2,_) -> compare name1 name2) vars in
-					List.iter (fun (name,load) ->
+					loop fl;
+					(* Step 2: Fields in order of constructor arguments *)
+					let order = List.sort (fun ((name1,_,_),_) ((name2,_,_),_) -> compare name1 name2) fl in
+					List.map (fun ((name,_,_),_) ->
+						let load = Hashtbl.find lut name in
 						load();
-						if List.mem_assoc name fl' then jm#cast (List.assoc name fl')
-					) vars;
-					List.map snd fl';
+						let cf = PMap.find name pfm.pfm_fields in
+						let jsig = self#vtype cf.cf_type in
+						jm#cast jsig;
+						jsig
+					) order;
 				)
-			| _ ->
+			| None ->
 				jm#construct ConstructInit haxe_dynamic_object_path (fun () -> []);
 				List.iter (fun ((name,_,_),e) ->
 					code#dup;

src/generators/genpy.ml

@@ -1342,16 +1342,7 @@ module Printer = struct
 			| TParenthesis e1 ->
 				Printf.sprintf "(%s)" (print_expr pctx e1)
 			| TObjectDecl fl ->
-				let fl2 = ref fl in
-				begin match follow e.etype with
-					| TAnon an ->
-						PMap.iter (fun s cf ->
-							if not (Expr.field_mem_assoc s fl) then fl2 := ((s,null_pos,NoQuotes),null cf.cf_type cf.cf_pos) :: !fl2
-						) an.a_fields
-					| _ ->
-						()
-				end;
-				Printf.sprintf "_hx_AnonObject(%s)" (print_exprs_named pctx ", " !fl2)
+				Printf.sprintf "_hx_AnonObject(%s)" (print_exprs_named pctx ", " fl)
 			| TArrayDecl el ->
 				Printf.sprintf "[%s]" (print_exprs pctx ", " el)
 			| TCall(e1,el) ->

tests/misc/projects/Issue10504/Main.hx

@@ -0,0 +1,12 @@
+class Main {
+	static function main() {
+		var v = { a : 1, foo : null };
+		$type(v);
+		parse1(v);
+		$type(v);
+		parse2(v);
+	}
+
+	extern static function parse1( v : { a : Int, ?b:Int } ):Void;
+	extern static function parse2( v : { a : Int, ?b:String } ):Void;
+}

tests/misc/projects/Issue10504/compile-fail.hxml

@@ -0,0 +1 @@
+--main Main

tests/misc/projects/Issue10504/compile-fail.hxml.stderr

@@ -0,0 +1,6 @@
+Main.hx:4: characters 9-10 : Warning : { foo : Unknown<0>, a : Int }
+Main.hx:6: characters 9-10 : Warning : { foo : Unknown<0>, ?b : Null<Int>, a : Int }
+Main.hx:7: characters 10-11 : error: Int should be String
+Main.hx:7: characters 10-11 : ... have: { b: Int }
+Main.hx:7: characters 10-11 : ... want: { b: String }
+Main.hx:7: characters 10-11 : ... For function argument 'v'