remove global values from deprecation handling (#11134)

src/compiler/compiler.ml

@@ -409,7 +409,10 @@ let process_actx ctx actx =
 	DisplayProcessing.process_display_arg ctx actx;
 	List.iter (fun s ->
 		ctx.com.warning WDeprecated [] s null_pos
-	) actx.deprecations
+	) actx.deprecations;
+	if defined ctx.com NoDeprecationWarnings then begin
+		ctx.com.warning_options <- [{wo_warning = WDeprecated; wo_mode = WMDisable}] :: ctx.com.warning_options
+	end
 
 let compile_ctx callbacks ctx =
 	let run ctx =

src/context/display/deprecationCheck.ml

@@ -3,37 +3,46 @@ open Type
 open Common
 open Ast
 
-let curclass = ref null_class
-let curfield = ref null_field
+type deprecation_context = {
+	com        : Common.context;
+	class_meta : metadata_entry list;
+	field_meta : metadata_entry list;
+}
+
+let create_context com = {
+	com = com;
+	class_meta = [];
+	field_meta = [];
+}
 
 let warned_positions = Hashtbl.create 0
 
-let warn_deprecation com s p_usage =
+let warn_deprecation dctx s p_usage =
 	let pkey p = (p.pfile,p.pmin) in
 	if not (Hashtbl.mem warned_positions (pkey p_usage)) then begin
 		Hashtbl.add warned_positions (pkey p_usage) (s,p_usage);
-		if not (is_diagnostics com) then begin
-			let options = Warning.from_meta (!curclass.cl_meta @ !curfield.cf_meta) in
-			com.warning WDeprecated options s p_usage;
+		if not (is_diagnostics dctx.com) then begin
+			let options = Warning.from_meta (dctx.class_meta @ dctx.field_meta) in
+			dctx.com.warning WDeprecated options s p_usage;
 		end
 	end
 
-let print_deprecation_message com meta s p_usage =
+let print_deprecation_message dctx meta s p_usage =
 	let s = match meta with
 		| _,[EConst(String(s,_)),_],_ -> s
 		| _ -> Printf.sprintf "Usage of this %s is deprecated" s
 	in
-	warn_deprecation com s p_usage
+	warn_deprecation dctx s p_usage
 
-let check_meta com meta s p_usage =
+let check_meta dctx meta s p_usage =
 	try
-		print_deprecation_message com (Meta.get Meta.Deprecated meta) s p_usage;
+		print_deprecation_message dctx (Meta.get Meta.Deprecated meta) s p_usage;
 	with Not_found ->
 		()
 
 let check_cf com cf p = check_meta com cf.cf_meta "field" p
 
-let check_class com c p = if c != !curclass then check_meta com c.cl_meta "class" p
+let check_class dctx c p = check_meta dctx c.cl_meta "class" p
 
 let check_enum com en p = check_meta com en.e_meta "enum" p
 
@@ -83,55 +92,31 @@ let run_on_expr com e =
 	in
 	expr e
 
-let run_on_field com cf =
+let run_on_field dctx cf =
 	match cf.cf_expr with
-	| None ->
+	| Some e when not (Meta.has Meta.Deprecated cf.cf_meta) ->
+		run_on_expr {dctx with field_meta = cf.cf_meta} e
+	| _ ->
 		()
-	| Some e ->
-		curfield := cf;
-		run_on_expr com e;
-		curfield := null_field
 
 let run com =
+	let dctx = create_context com in
 	List.iter (fun t -> match t with
-		| TClassDecl c ->
-			curclass := c;
-			(match c.cl_constructor with None -> () | Some cf -> run_on_field com cf);
-			(match c.cl_init with None -> () | Some e -> run_on_expr com e);
-			List.iter (run_on_field com) c.cl_ordered_statics;
-			List.iter (run_on_field com) c.cl_ordered_fields;
-			curclass := null_class;
+		| TClassDecl c when not (Meta.has Meta.Deprecated c.cl_meta) ->
+			let dctx = {dctx with class_meta = c.cl_meta} in
+			(match c.cl_constructor with None -> () | Some cf -> run_on_field dctx cf);
+			(match c.cl_init with None -> () | Some e -> run_on_expr dctx e);
+			List.iter (run_on_field dctx) c.cl_ordered_statics;
+			List.iter (run_on_field dctx) c.cl_ordered_fields;
 		| _ ->
 			()
 	) com.types
 
-let if_enabled ?(force=false) com fn =
-	if force || not (defined com Define.NoDeprecationWarnings) then fn()
-
-let warn_deprecation ?(force=false) com s p_usage = if_enabled ~force com (fun() -> warn_deprecation com s p_usage)
-
-let print_deprecation_message ?(force=false) com meta s p_usage = if_enabled ~force com (fun() -> print_deprecation_message com meta s p_usage)
-
-let check_meta ?(force=false) com meta s p_usage = if_enabled ~force com (fun() -> check_meta com meta s p_usage)
-
-let check_cf ?(force=false) com cf p = if_enabled ~force com (fun() -> check_cf com cf p)
-
-let check_class ?(force=false) com c p = if_enabled ~force com (fun() -> check_class com c p)
-
-let check_enum ?(force=false) com en p = if_enabled ~force com (fun() -> check_enum com en p)
-
-let check_ef ?(force=false) com ef p = if_enabled ~force com (fun() -> check_ef com ef p)
-
-let check_typedef ?(force=false) com t p = if_enabled ~force com (fun() -> check_typedef com t p)
-
-let check_module_type ?(force=false) com mt p = if_enabled ~force com (fun() -> check_module_type com mt p)
-
-let run_on_expr ?(force=false) com e = if_enabled ~force com (fun() -> run_on_expr com e)
-
-let run_on_field ?(force=false) com cf = if_enabled ~force com (fun() -> run_on_field com cf)
-
-let run ?(force=false) com = if_enabled ~force com (fun() -> run com)
-
-let check_is com name meta p =
-	if is_next com && name = "is" && not (Meta.has Meta.Deprecated meta) then
-		warn_deprecation com "Using \"is\" as an identifier is deprecated" p
+let check_is com cl_meta cf_meta name meta p =
+	let dctx = {
+		com = com;
+		class_meta = cl_meta;
+		field_meta = cf_meta;
+	} in
+	if is_next dctx.com && name = "is" && not (Meta.has Meta.Deprecated meta) then
+		warn_deprecation dctx "Using \"is\" as an identifier is deprecated" p

src/context/display/diagnostics.ml

@@ -93,20 +93,22 @@ let check_other_things com e =
 	in
 	loop true e
 
-let prepare_field dctx com cf = match cf.cf_expr with
+let prepare_field dctx dectx com cf = match cf.cf_expr with
 	| None -> ()
 	| Some e ->
 		find_unused_variables dctx e;
 		check_other_things com e;
-		DeprecationCheck.run_on_expr ~force:true com e
+		DeprecationCheck.run_on_expr {dectx with field_meta = cf.cf_meta} e
 
 let collect_diagnostics dctx com =
 	let open CompilationCache in
+	let dectx = DeprecationCheck.create_context com in
 	List.iter (function
 		| TClassDecl c when DiagnosticsPrinter.is_diagnostics_file com (com.file_keys#get c.cl_pos.pfile) ->
-			List.iter (prepare_field dctx com) c.cl_ordered_fields;
-			List.iter (prepare_field dctx com) c.cl_ordered_statics;
-			(match c.cl_constructor with None -> () | Some cf -> prepare_field dctx com cf);
+			let dectx = {dectx with class_meta = c.cl_meta} in
+			List.iter (prepare_field dctx dectx com) c.cl_ordered_fields;
+			List.iter (prepare_field dctx dectx com) c.cl_ordered_statics;
+			(match c.cl_constructor with None -> () | Some cf -> prepare_field dctx dectx com cf);
 		| _ ->
 			()
 	) com.types;

src/context/typecore.ml

@@ -721,6 +721,12 @@ let push_this ctx e = match e.eexpr with
 	let id,er = store_typed_expr ctx.com e e.epos in
 	er,fun () -> ctx.com.stored_typed_exprs#remove id
 
+let create_deprecation_context ctx = {
+	(DeprecationCheck.create_context ctx.com) with
+	class_meta = ctx.curclass.cl_meta;
+	field_meta = ctx.curfield.cf_meta;
+}
+
 (* -------------- debug functions to activate when debugging typer passes ------------------------------- *)
 (*/*
 

src/generators/genjs.ml

@@ -62,6 +62,7 @@ type ctx = {
 	mutable separator : bool;
 	mutable found_expose : bool;
 	mutable catch_vars : texpr list;
+	mutable deprecation_context : DeprecationCheck.deprecation_context;
 }
 
 type object_store = {
@@ -502,22 +503,22 @@ let rec gen_call ctx e el in_value =
 				abort "js.Lib.getOriginalException can only be called inside a catch block" e.epos
 		)
 	| TIdent "__new__", args ->
-		print_deprecation_message ctx.com "__new__ is deprecated, use js.Syntax.construct instead" e.epos;
+		print_deprecation_message ctx.deprecation_context "__new__ is deprecated, use js.Syntax.construct instead" e.epos;
 		gen_syntax ctx "construct" args e.epos
 	| TIdent "__js__", args ->
-		print_deprecation_message ctx.com "__js__ is deprecated, use js.Syntax.code instead" e.epos;
+		print_deprecation_message ctx.deprecation_context "__js__ is deprecated, use js.Syntax.code instead" e.epos;
 		gen_syntax ctx "code" args e.epos
 	| TIdent "__instanceof__",  args ->
-		print_deprecation_message ctx.com "__instanceof__ is deprecated, use js.Syntax.instanceof instead" e.epos;
+		print_deprecation_message ctx.deprecation_context "__instanceof__ is deprecated, use js.Syntax.instanceof instead" e.epos;
 		gen_syntax ctx "instanceof" args e.epos
 	| TIdent "__typeof__",  args ->
-		print_deprecation_message ctx.com "__typeof__ is deprecated, use js.Syntax.typeof instead" e.epos;
+		print_deprecation_message ctx.deprecation_context "__typeof__ is deprecated, use js.Syntax.typeof instead" e.epos;
 		gen_syntax ctx "typeof" args e.epos
 	| TIdent "__strict_eq__" , args ->
-		print_deprecation_message ctx.com "__strict_eq__ is deprecated, use js.Syntax.strictEq instead" e.epos;
+		print_deprecation_message ctx.deprecation_context "__strict_eq__ is deprecated, use js.Syntax.strictEq instead" e.epos;
 		gen_syntax ctx "strictEq" args e.epos
 	| TIdent "__strict_neq__" , args ->
-		print_deprecation_message ctx.com "__strict_neq__ is deprecated, use js.Syntax.strictNeq instead" e.epos;
+		print_deprecation_message ctx.deprecation_context "__strict_neq__ is deprecated, use js.Syntax.strictNeq instead" e.epos;
 		gen_syntax ctx "strictNeq" args e.epos
 	| TIdent "__define_feature__", [_;e] ->
 		gen_expr ctx e
@@ -1278,6 +1279,7 @@ let can_gen_class_field ctx = function
 		is_physical_field f
 
 let gen_class_field ctx c f =
+	ctx.deprecation_context <- {ctx.deprecation_context with field_meta = f.cf_meta};
 	check_field_name c f;
 	match f.cf_expr with
 	| None ->
@@ -1603,6 +1605,7 @@ let generate_class_es6 ctx c =
 
 let generate_class ctx c =
 	ctx.current <- c;
+	ctx.deprecation_context <- {ctx.deprecation_context with class_meta = c.cl_meta};
 	ctx.id_counter <- 0;
 	(match c.cl_path with
 	| [],"Function" -> abort "This class redefine a native one" c.cl_pos
@@ -1818,6 +1821,7 @@ let alloc_ctx com es_version =
 		separator = false;
 		found_expose = false;
 		catch_vars = [];
+		deprecation_context = DeprecationCheck.create_context com;
 	} in
 
 	ctx.type_accessor <- (fun t ->

src/generators/genphp7.ml

@@ -2012,7 +2012,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name =
 		*)
 		method write_expr_magic name args =
 			let msg = "untyped " ^ name ^ " is deprecated. Use php.Syntax instead." in
-			DeprecationCheck.warn_deprecation ctx.pgc_common msg self#pos;
+			DeprecationCheck.warn_deprecation (DeprecationCheck.create_context ctx.pgc_common) msg self#pos;
 			let error = ("Invalid arguments for " ^ name ^ " magic call") in
 			match args with
 				| [] -> fail ~msg:error self#pos __LOC__
@@ -3639,7 +3639,7 @@ class class_builder ctx (cls:tclass) =
 			(* Generate `__toString()` if not defined by user, but has `toString()` *)
 			self#write_toString_if_required
 		method private write_toString_if_required =
-			try 
+			try
 				let toString = PMap.find "toString" cls.cl_fields in
 				if (not (has_class_flag cls CInterface)) && (not (PMap.exists "__toString" cls.cl_statics)) && (not (PMap.exists "__toString" cls.cl_fields)) then
 					begin
@@ -3874,7 +3874,7 @@ class class_builder ctx (cls:tclass) =
 		*)
 		method private write_instance_initialization =
 			let init_dynamic_method field =
-				let field_name = field_name field 
+				let field_name = field_name field
 				and hx_closure = writer#use hxclosure_type_path in
 				writer#write_statement ("if ($this->" ^ field_name ^ " === null) $this->" ^ field_name ^ " = new " ^ hx_closure ^ "($this, '__hx__default__" ^ field_name ^ "')");
 			in

src/typing/callUnification.ml

@@ -448,7 +448,7 @@ object(self)
 		let ethis_f = ref (fun () -> ()) in
 		let f = (match ethis.eexpr with
 		| TTypeExpr (TClassDecl c) ->
-			DeprecationCheck.check_cf ctx.com cf p;
+			DeprecationCheck.check_cf (create_deprecation_context ctx) cf p;
 			(match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with
 			| None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
 			| Some (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = (!type_block_ref) ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos)

src/typing/matcher.ml

@@ -210,8 +210,9 @@ module Pattern = struct
 				v
 		in
 		let con_enum en ef p =
-			DeprecationCheck.check_enum pctx.ctx.com en p;
-			DeprecationCheck.check_ef pctx.ctx.com ef p;
+			let dctx = create_deprecation_context pctx.ctx in
+			DeprecationCheck.check_enum dctx en p;
+			DeprecationCheck.check_ef dctx ef p;
 			ConEnum(en,ef),p
 		in
 		let con_static c cf p = ConStatic(c,cf),p in
@@ -258,7 +259,7 @@ module Pattern = struct
 				| TTypeExpr mt ->
 					PatConstructor(con_type_expr mt e.epos,[])
 				| TMeta((Meta.Deprecated,_,_) as m, e1) ->
-					DeprecationCheck.check_meta pctx.ctx.com [m] "field" e1.epos;
+					DeprecationCheck.check_meta (create_deprecation_context pctx.ctx) [m] "field" e1.epos;
 					loop e1
 				| _ ->
 					raise Exit

src/typing/typeload.ml

@@ -314,16 +314,15 @@ let rec load_instance' ctx (t,p) allow_no_params =
 			| TClassDecl {cl_kind = KGenericBuild _} -> false,true,false
 			| TClassDecl c when (has_class_flag c CExtern) -> false,false,true
 			| TTypeDecl td ->
-				DeprecationCheck.if_enabled ctx.com (fun() ->
-					try
-						let msg = match Meta.get Meta.Deprecated td.t_meta with
-							| _,[EConst(String(s,_)),_],_ -> s
-							| _ -> "This typedef is deprecated in favor of " ^ (s_type (print_context()) td.t_type)
-						in
-						DeprecationCheck.warn_deprecation ctx.com msg p
-					with Not_found ->
+				begin try
+					let msg = match Meta.get Meta.Deprecated td.t_meta with
+						| _,[EConst(String(s,_)),_],_ -> s
+						| _ -> "This typedef is deprecated in favor of " ^ (s_type (print_context()) td.t_type)
+					in
+					DeprecationCheck.warn_deprecation (create_deprecation_context ctx) msg p
+				with Not_found ->
 						()
-				);
+				end;
 				false,false,false
 			| _ -> false,false,false
 		in

src/typing/typeloadFields.ml

@@ -656,7 +656,7 @@ let create_field_context cctx cff is_display_file display_modifier =
 	fctx
 
 let create_typer_context_for_field ctx cctx fctx cff =
-	DeprecationCheck.check_is ctx.com (fst cff.cff_name) cff.cff_meta (snd cff.cff_name);
+	DeprecationCheck.check_is ctx.com ctx.curclass.cl_meta cff.cff_meta (fst cff.cff_name) cff.cff_meta (snd cff.cff_name);
 	let ctx = {
 		ctx with
 		pass = PBuildClass; (* will be set later to PTypeExpr *)

src/typing/typeloadModule.ml

@@ -67,7 +67,7 @@ module ModuleLevel = struct
 		let decls = ref [] in
 		let statics = ref [] in
 		let check_name name meta also_statics p =
-			DeprecationCheck.check_is com name meta p;
+			DeprecationCheck.check_is com meta [] name meta p;
 			let error prev_pos =
 				display_error ctx.com ("Name " ^ name ^ " is already defined in this module") p;
 				typing_error ~depth:1 (compl_msg "Previous declaration here") prev_pos;
@@ -381,7 +381,7 @@ module TypeLevel = struct
 			ef_params = params;
 			ef_meta = c.ec_meta;
 		} in
-		DeprecationCheck.check_is ctx.com f.ef_name f.ef_meta f.ef_name_pos;
+		DeprecationCheck.check_is ctx.com e.e_meta f.ef_meta f.ef_name f.ef_meta f.ef_name_pos;
 		let cf = {
 			(mk_field f.ef_name f.ef_type p f.ef_name_pos) with
 			cf_kind = (match follow f.ef_type with

src/typing/typer.ml

@@ -686,7 +686,7 @@ and type_vars ctx vl p =
 	let vl = List.map (fun ev ->
 		let n = fst ev.ev_name
 		and pv = snd ev.ev_name in
-		DeprecationCheck.check_is ctx.com n ev.ev_meta pv;
+		DeprecationCheck.check_is ctx.com ctx.curclass.cl_meta ctx.curfield.cf_meta n ev.ev_meta pv;
 		try
 			let t = Typeload.load_type_hint ctx p ev.ev_type in
 			let e = (match ev.ev_expr with

src/typing/typerBase.ml

@@ -203,7 +203,7 @@ let rec type_module_type ctx t tparams p =
 		mk (TTypeExpr (TEnumDecl e)) (TType (e.e_type,types)) p
 	| TTypeDecl s ->
 		let t = apply_typedef s (List.map (fun _ -> spawn_monomorph ctx p) s.t_params) in
-		DeprecationCheck.check_typedef ctx.com s p;
+		DeprecationCheck.check_typedef (create_deprecation_context ctx) s p;
 		(match follow t with
 		| TEnum (e,params) ->
 			type_module_type ctx (TEnumDecl e) (Some params) p