bring back Const flag (closes #5206)

src/macro/interp.ml

@@ -4628,7 +4628,7 @@ and encode_anon_status s =
 	let tag, pl = (match s with
 		| Closed -> 0, []
 		| Opened -> 1, []
-		(* | Type.Const -> 2, [] *)
+		| Type.Const -> 2, []
 		| Extend tl -> 3, [encode_ref tl (fun tl -> enc_array (List.map encode_type tl)) (fun() -> "<extended types>")]
 		| Statics cl -> 4, [encode_clref cl]
 		| EnumStatics en -> 5, [encode_enref en]

src/optimization/optimizer.ml

@@ -531,6 +531,14 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			l.i_write <- true;
 			let e2 = map false e2 in
 			{e with eexpr = TBinop(op,{e1 with eexpr = TLocal l.i_subst},e2)}
+		| TObjectDecl fl ->
+			let fl = List.map (fun (s,e) -> s,map false e) fl in
+			begin match follow e.etype with
+				| TAnon an when (match !(an.a_status) with Const -> true | _ -> false) ->
+					{e with eexpr = TObjectDecl fl; etype = TAnon { an with a_status = ref Closed}}
+				| _ ->
+					{e with eexpr = TObjectDecl fl}
+			end
 		| TFunction f ->
 			(match f.tf_args with [] -> () | _ -> has_vars := true);
 			let old = save_locals ctx and old_fun = !in_local_fun in

src/typing/type.ml

@@ -90,6 +90,7 @@ and tfunc = {
 and anon_status =
 	| Closed
 	| Opened
+	| Const
 	| Extend of t list
 	| Statics of tclass
 	| EnumStatics of tenum
@@ -1805,7 +1806,7 @@ let rec unify a b =
 			(match !(an.a_status) with
 			| Opened -> an.a_status := Closed;
 			| Statics _ | EnumStatics _ | AbstractStatics _ -> error []
-			| Closed | Extend _ -> ())
+			| Closed | Extend _ | Const -> ())
 		with
 			Unify_error l -> error (cannot_unify a b :: l))
 	| TAnon a1, TAnon a2 ->
@@ -1929,11 +1930,14 @@ and unify_anons a b a1 a2 =
 				| Opened ->
 					if not (link (ref None) a f2.cf_type) then error [];
 					a1.a_fields <- PMap.add n f2 a1.a_fields
+				| Const when Meta.has Meta.Optional f2.cf_meta ->
+					()
 				| _ ->
-					if not (Meta.has Meta.Optional f2.cf_meta) then
-						error [has_no_field a n];
+					error [has_no_field a n];
 		) a2.a_fields;
 		(match !(a1.a_status) with
+		| Const when not (PMap.is_empty a2.a_fields) ->
+			PMap.iter (fun n _ -> if not (PMap.mem n a2.a_fields) then error [has_extra_field a n]) a1.a_fields;
 		| Opened ->
 			a1.a_status := Closed
 		| _ -> ());
@@ -1942,7 +1946,7 @@ and unify_anons a b a1 a2 =
 		| EnumStatics e -> (match !(a1.a_status) with EnumStatics e2 when e == e2 -> () | _ -> error [])
 		| AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error [])
 		| Opened -> a2.a_status := Closed
-		| Extend _ | Closed -> ())
+		| Const | Extend _ | Closed -> ())
 	with
 		Unify_error l -> error (cannot_unify a b :: l))
 

src/typing/typer.ml

@@ -133,6 +133,34 @@ let get_abstract_froms a pl =
 			acc
 	) l a.a_from_field
 
+(*
+	temporally remove the constant flag from structures to allow larger unification
+*)
+let remove_constant_flag t callb =
+	let tmp = ref [] in
+	let rec loop t =
+		match follow t with
+		| TAnon a ->
+			if !(a.a_status) = Const then begin
+				a.a_status := Closed;
+				tmp := a :: !tmp;
+			end;
+			PMap.iter (fun _ f -> loop f.cf_type) a.a_fields;
+		|  _ ->
+			()
+	in
+	let restore() =
+		List.iter (fun a -> a.a_status := Const) (!tmp)
+	in
+	try
+		loop t;
+		let ret = callb (!tmp <> []) in
+		restore();
+		ret
+	with e ->
+		restore();
+		raise e
+
 let rec is_pos_infos = function
 	| TMono r ->
 		(match !r with
@@ -583,7 +611,7 @@ let rec unify_min_raise ctx (el:texpr list) : t =
 			let expr f = match f.cf_expr with None -> mk (TBlock []) f.cf_type f.cf_pos | Some e -> e in
 			let fields = List.fold_left (fun acc e ->
 				match follow e.etype with
-				| TAnon a ->
+				| TAnon a when !(a.a_status) = Const ->
 					if !fcount = -1 then begin
 						fcount := field_count a;
 						PMap.map (fun f -> [expr f]) a.a_fields
@@ -1245,6 +1273,7 @@ let rec using_field ctx mode e i p =
 		| TMono _ -> raise Not_found
 		| t -> t == t_dynamic
 	in
+	let check_constant_struct = ref false in
 	let rec loop = function
 	| [] ->
 		raise Not_found
@@ -1274,6 +1303,7 @@ let rec using_field ctx mode e i p =
 		with Not_found ->
 			loop l
 		| Unify_error el | Error (Unify el,_) ->
+			if List.exists (function Has_extra_field _ -> true | _ -> false) el then check_constant_struct := true;
 			loop l
 	in
 	try loop ctx.m.module_using with Not_found ->
@@ -1284,7 +1314,8 @@ let rec using_field ctx mode e i p =
 		| _ -> assert false);
 		acc
 	with Not_found ->
-	raise Not_found
+	if not !check_constant_struct then raise Not_found;
+	remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found)
 
 let rec type_ident_raise ctx i p mode =
 	match i with
@@ -3043,7 +3074,7 @@ and type_object_decl ctx fl with_type p =
 			let e = if is_quoted then wrap_quoted_meta e else e in
 			(n,e)
 		) fl in
-		let t = (TAnon { a_fields = !fields; a_status = ref Closed }) in
+		let t = (TAnon { a_fields = !fields; a_status = ref Const }) in
 		if not ctx.untyped then begin
 			(match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) field_map [] with
 				| [] -> ()
@@ -3070,9 +3101,12 @@ and type_object_decl ctx fl with_type p =
 			end else acc)
 		in
 		let fields , types = List.fold_left loop ([],PMap.empty) fl in
-		mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = ref Closed }) p
+		let x = ref Const in
+		ctx.opened <- x :: ctx.opened;
+		mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
 	| ODKWithStructure a ->
 		let t, fl = type_fields a.a_fields in
+		if !(a.a_status) <> Const then a.a_status := Closed;
 		mk (TObjectDecl fl) t p
 	| ODKWithClass (c,tl) ->
 		let t,ctor = get_constructor ctx c tl p in

tests/misc/projects/Issue3192/compile1-fail.hxml.stderr

@@ -1 +1,3 @@
-Main1.hx:3: characters 18-32 : { b : Int, a : Int } has extra field b
+Main1.hx:3: characters 18-32 : { b : Int, a : Int } has extra field b
+Main1.hx:3: characters 2-33 : { b : Int, a : Int } should be { a : Int }
+Main1.hx:3: characters 2-33 : { b : Int, a : Int } has extra field b

tests/misc/projects/Issue5206/Main.hx

@@ -0,0 +1,18 @@
+typedef A     =  { var pos: Int;           var len: Int; };
+typedef NOT_A =  { var pos: Array<String>; var len: Array<Float>; };
+
+typedef X = { @:optional var x:Int; @:optional var y:Int; };
+typedef Y = { var x:Int; var y:Int; };
+typedef Z = { @:optional var pos:Array<String>; @:optional var len:Array<Float>; };
+
+class Main {
+
+    static var a:A = { pos : 1, len : 2 };
+
+    static function main(){
+
+        var not_a:NOT_A = (((a:X):Y):Z); //   !!! should obviously not compile
+        not_a.pos.push("");
+
+    }
+}

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

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

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

@@ -0,0 +1,8 @@
+Main.hx:14: characters 28-33 : A should be X
+Main.hx:14: characters 28-33 : { pos : Int, len : Int } should be X
+Main.hx:14: characters 28-33 : { pos : Int, len : Int } should be { ?y : Null<Int>, ?x : Null<Int> }
+Main.hx:14: characters 28-33 : { pos : Int, len : Int } has no field x
+Main.hx:14: characters 26-39 : Y should be Z
+Main.hx:14: characters 26-39 : { y : Int, x : Int } should be Z
+Main.hx:14: characters 26-39 : { y : Int, x : Int } should be { ?pos : Null<Array<String>>, ?len : Null<Array<Float>> }
+Main.hx:14: characters 26-39 : { y : Int, x : Int } has no field len

tests/unit/src/unit/issues/Issue3192.hx

@@ -8,7 +8,7 @@ class Issue3192 extends Test {
 		var y1:{} = x1;
 		var y2:{} = x2;
 		var y3:{} = x3;
-		var z1:{x:Int} = x1;
+		// var z1:{x:Int} = x1;
 		var z2:{x:Int} = x2;
 		var z3:{x:Int} = x3;
 		eq(1, x1.x);

tests/unit/src/unit/issues/misc/Issue3183Macro.hx

@@ -80,7 +80,8 @@ class Issue3183Macro {
 						name: field.name,
 						type: null,
 						opt: false,
-						value: null
+						value: null,
+						meta: []
 					}
 				})
 			})