Parcourir la source

Merge branch 'development' into hxb_server_cache_simn_cleanup

# Conflicts:
#	src/core/tUnification.ml
#	src/typing/tanon_identification.ml
Simon Krajewski il y a 1 an
Parent
commit
2c9809d6ac

+ 1 - 1
src/codegen/gencommon/castDetect.ml

@@ -193,7 +193,7 @@ let rec type_eq gen param a b =
 			PMap.iter (fun n f1 ->
 				try
 					let f2 = PMap.find n a2.a_fields in
-					if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind f1.cf_kind f2.cf_kind)) then Type.error [invalid_kind n f1.cf_kind f2.cf_kind];
+					if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind ~strict:false f1.cf_kind f2.cf_kind)) then Type.error [invalid_kind n f1.cf_kind f2.cf_kind];
 					try
 						type_eq gen param f1.cf_type f2.cf_type
 					with

+ 14 - 6
src/core/tUnification.ml

@@ -29,7 +29,7 @@ type eq_kind =
 	| EqRightDynamic
 	| EqBothDynamic
 	| EqDoNotFollowNull (* like EqStrict, but does not follow Null<T> *)
-	| EqStrictStrict (* TODO *)
+	| EqStricter
 
 type unification_context = {
 	allow_transitive_cast   : bool;
@@ -432,7 +432,7 @@ let direct_access = function
 	| AccNo | AccNever | AccNormal | AccInline | AccRequire _ | AccCtor -> true
 	| AccCall -> false
 
-let unify_kind ?(strict:bool = false) k1 k2 =
+let unify_kind ~(strict:bool) k1 k2 =
 	k1 = k2 || match k1, k2 with
 		| Var v1, Var v2 -> unify_access v1.v_read v2.v_read && unify_access v1.v_write v2.v_write
 		| Method m1, Method m2 ->
@@ -495,8 +495,12 @@ let rec_stack_default stack value fcheck frun def =
 
 let rec type_eq uctx a b =
 	let param = uctx.equality_kind in
+	let can_follow_null = match param with
+		| EqStricter | EqDoNotFollowNull -> false
+		| _ -> true
+	in
 	let can_follow t = match param with
-		| EqStrictStrict -> false
+		| EqStricter -> false
 		| EqCoreType -> false
 		| EqDoNotFollowNull -> not (is_explicit_null t)
 		| _ -> true
@@ -528,9 +532,9 @@ let rec type_eq uctx a b =
 		()
 	| TAbstract ({a_path=[],"Null"},[t1]),TAbstract ({a_path=[],"Null"},[t2]) ->
 		type_eq uctx t1 t2
-	| TAbstract ({a_path=[],"Null"},[t]),_ when param <> EqDoNotFollowNull && param <> EqStrictStrict ->
+	| TAbstract ({a_path=[],"Null"},[t]),_ when can_follow_null ->
 		type_eq uctx t b
-	| _,TAbstract ({a_path=[],"Null"},[t]) when param <> EqDoNotFollowNull && param <> EqStrictStrict ->
+	| _,TAbstract ({a_path=[],"Null"},[t]) when can_follow_null ->
 		type_eq uctx a t
 	| TType (t1,tl1), TType (t2,tl2) when (t1 == t2 || (param = EqCoreType && t1.t_path = t2.t_path)) && List.length tl1 = List.length tl2 ->
 		type_eq_params uctx a b tl1 tl2
@@ -584,7 +588,11 @@ let rec type_eq uctx a b =
 			PMap.iter (fun n f1 ->
 				try
 					let f2 = PMap.find n a2.a_fields in
-					if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || param = EqDoNotFollowNull || param = EqStrictStrict || not (unify_kind ~strict:uctx.strict_field_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind];
+					let kind_should_match = match param with
+						| EqStrict | EqCoreType | EqDoNotFollowNull | EqStricter -> true
+						| _ -> false
+					in
+					if f1.cf_kind <> f2.cf_kind && (kind_should_match || not (unify_kind ~strict:uctx.strict_field_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind];
 					let a = f1.cf_type and b = f2.cf_type in
 					(try type_eq uctx a b with Unify_error l -> error (invalid_field n :: l));
 					if (has_class_field_flag f1 CfPublic) != (has_class_field_flag f2 CfPublic) then error [invalid_visibility n];

+ 1 - 1
src/generators/genshared.ml

@@ -301,7 +301,7 @@ class ['a] typedef_interfaces (infos : 'a info_context) (anon_identification : '
 			try
 				let path_inner,is_extern = try Hashtbl.find interface_rewrites pfm.pfm_path with Not_found -> path_inner,false in
 				if self#implements_recursively c path_inner then raise (Unify_error [Unify_custom "already implemented"]);
-				anon_identification#unify tc pfm;
+				anon_identification#unify ~strict:false tc pfm;
 				let ci = self#make_interface_class pfm path_inner is_extern in
 				c.cl_implements <- (ci,[]) :: c.cl_implements;
 				(* print_endline (Printf.sprintf "%s IMPLEMENTS %s" (s_type_path c.cl_path) (s_type_path path_inner)); *)

+ 5 - 5
src/typing/tanon_identification.ml

@@ -60,13 +60,13 @@ object(self)
 		DynArray.add (DynArray.get pfm_by_arity pfm.pfm_arity) pfm;
 		Hashtbl.replace pfms path pfm
 
-	method unify ?(strict:bool = false) (tc : Type.t) (pfm : 'a path_field_mapping) =
+	method unify ~(strict:bool) (tc : Type.t) (pfm : 'a path_field_mapping) =
 		let uctx = if strict then {
 			allow_transitive_cast = false;
 			allow_abstract_cast = false;
 			allow_dynamic_to_cast = false;
 			allow_arg_name_mismatch = false;
-			equality_kind = EqStrictStrict;
+			equality_kind = EqStricter;
 			equality_underlying = false;
 			strict_field_kind = true;
 		} else {default_unification_context with equality_kind = EqDoNotFollowNull} in
@@ -117,7 +117,7 @@ object(self)
 		with Not_found ->
 			raise (Unify_error [])
 
-	method find_compatible (strict : bool) (arity : int) (tc : Type.t) =
+	method find_compatible ~(strict : bool) (arity : int) (tc : Type.t) =
 		if arity >= DynArray.length pfm_by_arity then
 			raise Not_found;
 		let d = DynArray.get pfm_by_arity arity in
@@ -128,7 +128,7 @@ object(self)
 				raise Not_found;
 			let pfm = DynArray.unsafe_get d i in
 			try
-				if strict then self#unify ~strict tc pfm else self#unify tc pfm;
+				self#unify ~strict tc pfm;
 				pfm
 			with Unify_error _ ->
 				loop (i + 1)
@@ -172,7 +172,7 @@ object(self)
 			) an.a_fields (0,PMap.empty) in
 			let an = { a_fields = fields; a_status = an.a_status; } in
 			try
-				Some (self#find_compatible strict arity (TAnon an))
+				Some (self#find_compatible ~strict arity (TAnon an))
 			with Not_found ->
 				let id = num in
 				num <- num + 1;

+ 1 - 1
src/typing/typeloadCheck.ml

@@ -394,7 +394,7 @@ module Inheritance = struct
 					in
 					if (has_class_field_flag f CfPublic) && not (has_class_field_flag f2 CfPublic) && not (Meta.has Meta.CompilerGenerated f.cf_meta) then
 						display_error ctx.com ("Field " ^ f.cf_name ^ " should be public as requested by " ^ s_type_path intf.cl_path) p
-					else if not (unify_kind f2.cf_kind f.cf_kind) || not (match f.cf_kind, f2.cf_kind with Var _ , Var _ -> true | Method m1, Method m2 -> mkind m1 = mkind m2 | _ -> false) then
+					else if not (unify_kind ~strict:false f2.cf_kind f.cf_kind) || not (match f.cf_kind, f2.cf_kind with Var _ , Var _ -> true | Method m1, Method m2 -> mkind m1 = mkind m2 | _ -> false) then
 						display_error ctx.com ("Field " ^ f.cf_name ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind ^ ")") p
 					else try
 						let map1 = TClass.get_map_function  intf params in

+ 3 - 2
std/haxe/ValueException.hx

@@ -18,7 +18,8 @@ class ValueException extends Exception {
 	/**
 		Thrown value.
 	**/
-	public var value(default,null):Any;
+	@:keep
+	public var value(default, null):Any;
 
 	public function new(value:Any, ?previous:Exception, ?native:Any):Void {
 		super(#if js js.Syntax.code('String({0})', value) #else Std.string(value) #end, previous, native);
@@ -35,4 +36,4 @@ class ValueException extends Exception {
 	override function unwrap():Any {
 		return value;
 	}
-}
+}