From 49b3f20875457969205d294786cfd01b4a3d6e26 Mon Sep 17 00:00:00 2001
From: Allan Blanchard <allan.blanchard@cea.fr>
Date: Tue, 23 Jul 2024 08:48:43 +0200
Subject: [PATCH] [kernel] more conventional option creation for directories
---
.../cmdline_parameters/parameter_builder.ml | 17 ++++++-----------
.../cmdline_parameters/parameter_sig.ml | 8 +++-----
.../misc/user_directories.unix.t/directories.ml | 12 ++++++++----
3 files changed, 17 insertions(+), 20 deletions(-)
diff --git a/src/kernel_services/cmdline_parameters/parameter_builder.ml b/src/kernel_services/cmdline_parameters/parameter_builder.ml
index 22ea00848f..f8e95e6cd3 100644
--- a/src/kernel_services/cmdline_parameters/parameter_builder.ml
+++ b/src/kernel_services/cmdline_parameters/parameter_builder.ml
@@ -577,21 +577,16 @@ struct
module Make_user_dir_opt
(Parent: Parameter_sig.User_dir)
(Info: sig
- val name: string
+ include Parameter_sig.Input_with_arg
val env: string option
- val help: string
+ val dirname: string
end): Parameter_sig.User_dir_opt
=
struct
- let is_kernel = P.shortname = ""
- let prefix = "-" ^ (if is_kernel then "" else P.shortname ^ "-")
-
module Dir_name =
Filepath
(struct
- let option_name = prefix ^ Info.name
- let arg_name = "dir"
- let help = Info.help
+ include Info
let existence = Fc_Filepath.Indifferent
let file_kind = ""
end)
@@ -601,7 +596,7 @@ struct
else
match Option.bind Info.env Sys.getenv_opt with
| Some s when s <> "" -> Fc_Filepath.Normalized.of_string s
- | _ -> Parent.get_dir Info.name
+ | _ -> Parent.get_dir Info.dirname
let set = Dir_name.set
let is_set = Dir_name.is_set
@@ -611,11 +606,11 @@ struct
try
if Extlib.mkdir ~parents:true d' 0o755 then
P.L.warning "created %s directory `%a'"
- Info.name Fc_Filepath.Normalized.pretty d';
+ Info.dirname Fc_Filepath.Normalized.pretty d';
d
with Unix.Unix_error _ ->
P.L.abort "cannot create %s directory `%a'"
- Info.name Fc_Filepath.Normalized.pretty d'
+ Info.dirname Fc_Filepath.Normalized.pretty d'
let get_dir ?(create_path=false) name =
let dir = Datatype.Filepath.concat (get ()) name in
diff --git a/src/kernel_services/cmdline_parameters/parameter_sig.ml b/src/kernel_services/cmdline_parameters/parameter_sig.ml
index 68162ec684..6d04fc0d81 100644
--- a/src/kernel_services/cmdline_parameters/parameter_sig.ml
+++ b/src/kernel_services/cmdline_parameters/parameter_sig.ml
@@ -661,16 +661,14 @@ module type Builder = sig
module Make_user_dir_opt
(_: User_dir)
(_: sig
- val name: string
- (** The name of the directory, also used to create an option of the
- form -<plugin>-<name>. *)
-
+ include Input_with_arg
val env: string option
(** Can be used to provide an environment variable that can be used
instead of the option. The option has higher priority.
*)
- val help: string
+ val dirname: string
+ (** The name of the directory *)
end): User_dir_opt
(** Allow using custom types as parameters.
diff --git a/tests/misc/user_directories.unix.t/directories.ml b/tests/misc/user_directories.unix.t/directories.ml
index d4eba52b5e..e9b949fdf8 100644
--- a/tests/misc/user_directories.unix.t/directories.ml
+++ b/tests/misc/user_directories.unix.t/directories.ml
@@ -22,18 +22,22 @@ module Sub_cache_opt_no_var =
Self.Make_user_dir_opt
(Cache)
(struct
- let name = "optnovar"
- let env = None
+ let option_name = "-dirs-opt-no-var"
+ let arg_name = "dir"
let help = ""
+ let env = None
+ let dirname = "optnovar"
end)
module Sub_cache_opt_var =
Self.Make_user_dir_opt
(Cache)
(struct
- let name = "optvar"
- let env = Some "FRAMAC_DIRS_VAR"
+ let option_name = "-dirs-optvar"
+ let arg_name = "dir"
let help = ""
+ let env = Some "FRAMAC_DIRS_VAR"
+ let dirname = "optvar"
end)
module Config = Self.Config_dir ()
--
GitLab