diff --git a/src/kernel_services/cmdline_parameters/cmdline.ml b/src/kernel_services/cmdline_parameters/cmdline.ml index 7178eea308baa39f99a9b24256212fe49a9e5d13..b9e34c5015cb39aed04e9a6ea38d14108cebe7e1 100644 --- a/src/kernel_services/cmdline_parameters/cmdline.ml +++ b/src/kernel_services/cmdline_parameters/cmdline.ml @@ -253,6 +253,11 @@ type option_setting = | Int of (int -> unit) | String of (string -> unit) +let option_setting_and_warn warn = function + | Unit f -> Unit (fun () -> warn (); f ()) + | Int f -> Int (fun i -> warn (); f i) + | String f -> String (fun s -> warn (); f s) + exception Cannot_parse of string * string let raise_error name because = raise (Cannot_parse(name, because)) @@ -436,7 +441,8 @@ module Plugin: sig val add_group: ?memo:bool -> plugin:string -> string -> string * bool val add_option: string -> group:string -> cmdline_option -> unit val add_aliases: - orig:string -> string -> group:string -> string list -> cmdline_option list + orig:string -> string -> group:string -> ?visible:bool -> ?deprecated:bool + -> string list -> cmdline_option list val replace_option_setting: string -> plugin:string -> group:string -> option_setting -> unit val replace_option_help: @@ -525,7 +531,7 @@ end = struct (* table name_of_the_original_option --> aliases *) let aliases_tbl = Hashtbl.create 7 - let add_aliases ~orig shortname ~group names = + let add_aliases ~orig shortname ~group ?(visible=true) ?(deprecated=false) names = (* mostly inline [add_option] and perform additional actions *) let options_group = find_group shortname group in let option = List.find (fun o -> o.oname = orig) !options_group in @@ -533,7 +539,19 @@ end = struct if name = "" then invalid_arg "empty alias name"; Hashtbl.replace all_options name option; Option_names.add name true; - let alias = { option with oname = name } in + let setting = + if deprecated + then + let warn () = + Kernel_log.warning ~once:true + "@[%s is@ a deprecated alias@ for option %s.@ \ + Please use %s instead.@]" + name option.oname option.oname + in + option_setting_and_warn warn option.setting + else option.setting + in + let alias = { option with oname = name; ovisible = visible; setting; } in options_group := alias :: !options_group; alias in @@ -723,8 +741,8 @@ let add_option_without_action ohelp = help; ext_help = ext_help; ovisible = visible; setting = Unit (fun () -> assert false) } -let add_aliases orig ~plugin ~group stage aliases = - let l = Plugin.add_aliases ~orig plugin ~group aliases in +let add_aliases orig ~plugin ~group ?visible ?deprecated stage aliases = + let l = Plugin.add_aliases ~orig plugin ~group ?visible ?deprecated aliases in let add = match stage with | Early -> Early_Stage.add_for_parsing | Extending -> Extending_Stage.add_for_parsing @@ -899,7 +917,8 @@ let low_print_option_help fmt print_invisible o = print_helpline fmt (name ^ ty) o.ohelp o.ext_help; List.iter (fun o -> - print_helpline fmt (o.oname ^ ty) ("alias for option " ^ name) "") + if print_invisible || o.ovisible then + print_helpline fmt (o.oname ^ ty) ("alias for option " ^ name) "") (Plugin.find_option_aliases o) end; true diff --git a/src/kernel_services/cmdline_parameters/cmdline.mli b/src/kernel_services/cmdline_parameters/cmdline.mli index b3eda2c34f96f9ace1ebe4bac1372807ef829d21..025cb25859989a8d7aaf8889f1ad4ae3d0c8ea16 100644 --- a/src/kernel_services/cmdline_parameters/cmdline.mli +++ b/src/kernel_services/cmdline_parameters/cmdline.mli @@ -313,13 +313,18 @@ val add_aliases: string -> plugin:string -> group:Group.t -> + ?visible: bool -> + ?deprecated: bool -> stage -> string list -> unit (** [add_aliases orig plugin group aliases] adds a list of aliases to the given option name [orig]. + If [visible] is set to false, the aliases do not appear in help messages. + If [deprecated] is set to true, the use of the aliases emits a warning. @Invalid_argument if an alias name is the empty string - @since Carbon-20110201 *) + @since Carbon-20110201 + @modify Frama-c+dev add [visible] and [deprecated] arguments. *) val replace_option_setting: string -> plugin:string -> group:Group.t -> option_setting -> unit diff --git a/src/kernel_services/cmdline_parameters/parameter_builder.ml b/src/kernel_services/cmdline_parameters/parameter_builder.ml index 533be6968e7c37f0b8e0eb30919a465623537770..5675500ced75e97c56b01bcc5e0cf583f2798f12 100644 --- a/src/kernel_services/cmdline_parameters/parameter_builder.ml +++ b/src/kernel_services/cmdline_parameters/parameter_builder.ml @@ -223,14 +223,15 @@ struct ~plugin X.option_name Typed_parameter.ty ~journalize:false p else p - let add_aliases list = - add_aliases list; + let add_aliases ?visible ?deprecated list = + add_aliases ?visible ?deprecated list; match !negative_option_ref with | None -> () | Some negative_option -> let negative_list = List.map negate_name list in let plugin = P.shortname in - Cmdline.add_aliases negative_option ~plugin ~group stage negative_list + Cmdline.add_aliases + negative_option ~plugin ~group ?visible ?deprecated stage negative_list end @@ -1719,8 +1720,8 @@ struct f (); end - let add_aliases list = - add_aliases list; + let add_aliases ?visible ?deprecated list = + add_aliases ?visible ?deprecated list; Output.add_aliases (List.map (fun alias -> alias ^ "-print") list) end diff --git a/src/kernel_services/cmdline_parameters/parameter_sig.mli b/src/kernel_services/cmdline_parameters/parameter_sig.mli index 9ab4f1cca7e940a4f2b0cc4ca127f70c19a78f68..89a439f71b324967ac4c0775bf8eaf4587a86af8 100644 --- a/src/kernel_services/cmdline_parameters/parameter_sig.mli +++ b/src/kernel_services/cmdline_parameters/parameter_sig.mli @@ -179,10 +179,13 @@ module type S_no_parameter = sig val equal: t -> t -> bool - val add_aliases: string list -> unit + val add_aliases: ?visible: bool -> ?deprecated:bool -> string list -> unit (** Add some aliases for this option. That is other option names which have exactly the same semantics that the initial option. - @raise Invalid_argument if one of the strings is empty *) + If [visible] is set to false, the aliases do not appear in help messages. + If [deprecated] is set to true, the use of the aliases emits a warning. + @raise Invalid_argument if one of the strings is empty + @modify Frama-c+dev add [visible] and [deprecated] arguments. *) (**/**) val is_set: unit -> bool diff --git a/src/kernel_services/cmdline_parameters/parameter_state.ml b/src/kernel_services/cmdline_parameters/parameter_state.ml index a61ea576898dec21a9e3a700a6231b9967de394e..8941eec275878ca1c8a2910fbc536089dd161f2a 100644 --- a/src/kernel_services/cmdline_parameters/parameter_state.ml +++ b/src/kernel_services/cmdline_parameters/parameter_state.ml @@ -270,8 +270,9 @@ struct let option_name = X.option_name - let add_aliases = - Cmdline.add_aliases option_name ~plugin:P.shortname ~group stage + let add_aliases ?visible ?deprecated = + Cmdline.add_aliases + option_name ~plugin:P.shortname ~group stage ?visible ?deprecated let print_help fmt = Cmdline.print_option_help fmt ~plugin:P.shortname ~group option_name diff --git a/src/kernel_services/plugin_entry_points/plugin.ml b/src/kernel_services/plugin_entry_points/plugin.ml index 06ec07489dc851480fc9b9964637474f4ba26b4c..067694ad12cb107d320981e31c57ea563506903a 100644 --- a/src/kernel_services/plugin_entry_points/plugin.ml +++ b/src/kernel_services/plugin_entry_points/plugin.ml @@ -44,7 +44,8 @@ module type S_no_log = sig module Config: Parameter_sig.Specific_dir val help: Cmdline.Group.t val messages: Cmdline.Group.t - val add_plugin_output_aliases: string list -> unit + val add_plugin_output_aliases: + ?visible:bool -> ?deprecated:bool -> string list -> unit end module type S = sig @@ -795,14 +796,14 @@ struct let is_kernel = is_kernel () in Warn_category.add_set_hook (parse_warn_directives is_kernel) - let add_plugin_output_aliases aliases = + let add_plugin_output_aliases ?visible ?deprecated aliases = let aliases = List.filter (fun alias -> alias <> "") aliases in let optname suffix = List.map (fun alias -> "-" ^ alias ^ suffix) aliases in - Help.add_aliases (optname "-help"); - Verbose.add_aliases (optname "-verbose"); - Debug_category.add_aliases (optname "-msg-key"); - Warn_category.add_aliases (optname "-warn-key"); - LogToFile.add_aliases (optname "-log") + Help.add_aliases ?visible ?deprecated (optname "-help"); + Verbose.add_aliases ?visible ?deprecated (optname "-verbose"); + Debug_category.add_aliases ?visible ?deprecated (optname "-msg-key"); + Warn_category.add_aliases ?visible ?deprecated (optname "-warn-key"); + LogToFile.add_aliases ?visible ?deprecated (optname "-log") let () = reset_plugin () diff --git a/src/kernel_services/plugin_entry_points/plugin.mli b/src/kernel_services/plugin_entry_points/plugin.mli index a5e41ee354ec50753ba9200ccb84281524757210..16c14c026ae910efbfd982597627c683983bf5ba 100644 --- a/src/kernel_services/plugin_entry_points/plugin.mli +++ b/src/kernel_services/plugin_entry_points/plugin.mli @@ -64,12 +64,14 @@ module type S_no_log = sig (** The group containing options -*-debug and -*-verbose. @since Boron-20100401 *) - val add_plugin_output_aliases: string list -> unit - (** Adds aliases to the options -plugin-help, -plugin-verbose, -plugin-log, - -plugin-msg-key, and -plugin-warn-key. - [add_plugin_output_aliases [alias]] adds the aliases -alias-help, - -alias-verbose, etc. - @since 18.0-Argon *) + val add_plugin_output_aliases: + ?visible:bool -> ?deprecated:bool -> string list -> unit + (** Adds aliases to the options -plugin-help, -plugin-verbose, -plugin-log, + -plugin-msg-key, and -plugin-warn-key. + [add_plugin_output_aliases [alias]] adds the aliases -alias-help, + -alias-verbose, etc. + @since 18.0-Argon + @modify Frama-c+dev add [visible] and [deprecated] arguments. *) end (** Provided plug-general services for plug-ins.