Clean up warning handling and add optional WUnsafeEnumEquality

src-json/warning.json

@@ -118,6 +118,12 @@
 		"doc": "Constructor call could not be inlined because a field is uninitialized",
 		"parent": "WTyper"
 	},
+	{
+		"name": "WUnsafeEnumEquality",
+		"doc": "Equality operations on enums with parameters might not work as expected",
+		"parent": "WTyper",
+		"enabled": false
+	},
 	{
 		"name": "WHxb",
 		"doc": "Hxb (either --hxb output or haxe compiler cache) related warnings"

src-prebuild/prebuild.ml

@@ -7,6 +7,7 @@ type parsed_warning = {
 	w_doc : string;
 	w_parent : string option;
 	w_generic : bool;
+	w_enabled : bool;
 }
 
 type parsed_meta = {
@@ -143,6 +144,7 @@ let parse_warning json =
 		w_doc = get_field "doc" as_string fields;
 		w_parent = get_optional_field2 "parent" as_string fields;
 		w_generic = get_optional_field "generic" as_bool false fields;
+		w_enabled = get_optional_field "enabled" as_bool true fields;
 	}
 
 let parse_file_array path map =
@@ -255,6 +257,15 @@ let gen_warning_obj warnings =
 	) warnings in
 	String.concat "\n" warning_str
 
+let gen_disabled_warnings warnings =
+	let warning_str = ExtList.List.filter_map (fun w ->
+		if w.w_enabled then
+			None
+		else
+			Some w.w_name
+	) warnings in
+	String.concat ";" warning_str
+
 let autogen_header = "(* This file is auto-generated using prebuild from files in src-json *)
 (* Do not edit manually! *)
 "
@@ -355,6 +366,10 @@ match Array.to_list (Sys.argv) with
 		print_endline "";
 		print_endline "let warning_obj = function";
 		print_endline (gen_warning_obj warnings);
+		print_endline ";;";
+		print_endline "let disabled_warnings = [";
+		print_endline (gen_disabled_warnings warnings);
+		print_endline "];;";
 		print_endline "";
 		print_endline "let from_string = function";
 		print_endline (gen_warning_parse warnings);

src/compiler/compiler.ml

@@ -241,7 +241,7 @@ module Setup = struct
 			message ctx (make_compiler_message ~from_macro msg p depth DKCompilerMessage Information)
 		);
 		com.warning <- (fun ?(depth=0) ?(from_macro=false) w options msg p ->
-			match Warning.get_mode w (com.warning_options @ options) with
+			match Warning.get_mode w (options @ com.warning_options) with
 			| WMEnable ->
 				let wobj = Warning.warning_obj w in
 				let msg = if wobj.w_generic then

src/compiler/displayProcessing.ml

@@ -96,7 +96,7 @@ let process_display_configuration ctx =
 			add_diagnostics_message ?depth com s p DKCompilerMessage Information
 		);
 		com.warning <- (fun ?(depth = 0) ?from_macro w options s p ->
-			match Warning.get_mode w (com.warning_options @ options) with
+			match Warning.get_mode w (options @ com.warning_options) with
 			| WMEnable ->
 				let wobj = Warning.warning_obj w in
 				add_diagnostics_message ~depth ~code:(Some wobj.w_name) com s p DKCompilerMessage Warning

src/context/common.ml

@@ -827,7 +827,7 @@ let create compilation_step cs version args display_mode =
 		get_macros = (fun() -> None);
 		info = (fun ?depth ?from_macro _ _ -> die "" __LOC__);
 		warning = (fun ?depth ?from_macro _ _ _ -> die "" __LOC__);
-		warning_options = [];
+		warning_options = [List.map (fun w -> {wo_warning = w;wo_mode = WMDisable}) WarningList.disabled_warnings];
 		error = (fun ?depth _ _ -> die "" __LOC__);
 		error_ext = (fun _ -> die "" __LOC__);
 		get_messages = (fun() -> []);

src/context/typecore.ml

@@ -358,7 +358,7 @@ let type_generic_function_ref : (typer -> field_access -> (unit -> texpr) field_
 let create_context_ref : (Common.context -> ((unit -> unit) * typer) option -> typer) ref = ref (fun _ -> assert false)
 
 let warning ?(depth=0) ctx w msg p =
-	let options = (Warning.from_meta ctx.c.curclass.cl_meta) @ (Warning.from_meta ctx.f.curfield.cf_meta) in
+	let options = (Warning.from_meta ctx.f.curfield.cf_meta) @ (Warning.from_meta ctx.c.curclass.cl_meta) in
 	match Warning.get_mode w options with
 	| WMEnable ->
 		module_warning ctx.com ctx.m.curmod w options msg p

src/core/warning.ml

@@ -79,17 +79,20 @@ let get_mode w (l : warning_option list list) =
 			| None -> false
 			| Some w' -> matches w' id
 	in
-	let rec loop mode l = match l with
+	let rec loop l = match l with
 		| [] ->
-			mode
+			WMEnable
 		| l2 :: l ->
-			let rec loop2 mode l = match l with
+			let rec loop2 l = match l with
 				| [] ->
-					mode
+					None
 				| opt :: l ->
-					let mode = if matches w opt.wo_warning then opt.wo_mode else mode in
-					loop2 mode l
+					if matches w opt.wo_warning then Some opt.wo_mode else loop2 l
 			in
-			loop (loop2 mode l2) l
+			match loop2 l2 with
+			| None ->
+				loop l
+			| Some mode ->
+				mode
 	in
-	loop WMEnable (* ? *) l
+	loop l

src/typing/operators.ml

@@ -333,12 +333,17 @@ let make_binop ctx op e1 e2 is_assign_op p =
 		with Error { err_message = Unify _ } ->
 			e1,AbstractCast.cast_or_unify ctx e1.etype e2 p
 		in
-		if not ctx.com.config.pf_supports_function_equality then begin match e1.eexpr, e2.eexpr with
+		begin match e1.eexpr, e2.eexpr with
 		| TConst TNull , _ | _ , TConst TNull -> ()
 		| _ ->
 			match follow e1.etype, follow e2.etype with
-			| TFun _ , _ | _, TFun _ -> warning ctx WClosureCompare "Comparison of function values is unspecified on this target, use Reflect.compareMethods instead" p
-			| _ -> ()
+			| TFun _ , _ | _, TFun _ when not ctx.com.config.pf_supports_function_equality ->
+				warning ctx WClosureCompare "Comparison of function values is unspecified on this target, use Reflect.compareMethods instead" p
+			| TEnum(en,_), _ | _, TEnum(en,_) ->
+				if not (Meta.has Meta.FlatEnum en.e_meta) then
+					warning ctx WUnsafeEnumEquality "Equality operations on this enum might lead to unexpected results because some constructors have arguments" p
+			| _ ->
+				()
 		end;
 		mk_op e1 e2 ctx.t.tbool
 	| OpGt

tests/misc/projects/Issue11813/Main.hx

@@ -0,0 +1,21 @@
+enum FlatEnum {
+	A;
+	B;
+}
+
+enum ThickEnum {
+	C;
+	DD(i:Int);
+}
+
+function main() {
+	var flat1 = A;
+	var flat2 = B;
+	if (flat1 == flat2) {}
+	if (flat1 != flat2) {}
+
+	var thick1 = C;
+	var thick2 = DD(1);
+	if (thick1 == thick2) {}
+	if (thick1 != thick2) {}
+}

tests/misc/projects/Issue11813/compile-without.hxml

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

tests/misc/projects/Issue11813/compile.hxml

@@ -0,0 +1,3 @@
+-m Main
+-w +WUnsafeEnumEquality
+--interp

tests/misc/projects/Issue11813/compile.hxml.stderr

@@ -0,0 +1,2 @@
+Main.hx:19: characters 6-22 : Warning : (WUnsafeEnumEquality) Equality operations on this enum might lead to unexpected results because some constructors have arguments
+Main.hx:20: characters 6-22 : Warning : (WUnsafeEnumEquality) Equality operations on this enum might lead to unexpected results because some constructors have arguments