From 3984bda429ed01677a82597a7118e57acbab8b3b Mon Sep 17 00:00:00 2001 From: Ambre Austen Suhamy Date: Thu, 11 Jul 2024 18:40:41 +0200 Subject: [PATCH 1/5] Added feature flag to enable dune cache by default Signed-off-by: Ambre Austen Suhamy Signed-off-by: Marek Kubica --- src/dune_config_file/dune_config_file.ml | 12 +++++-- src/dune_config_file/feature_flags.ml | 1 + .../blackbox-tests/test-cases/default-cache.t | 34 +++++++++++++++++++ 3 files changed, 44 insertions(+), 3 deletions(-) create mode 100644 src/dune_config_file/feature_flags.ml create mode 100644 test/blackbox-tests/test-cases/default-cache.t diff --git a/src/dune_config_file/dune_config_file.ml b/src/dune_config_file/dune_config_file.ml index 1bf91c61025..a9b83ef5a0c 100644 --- a/src/dune_config_file/dune_config_file.ml +++ b/src/dune_config_file/dune_config_file.ml @@ -11,6 +11,7 @@ module Dune_config = struct module Log = Dune_util.Log module Config = Dune_config.Config module Execution_env = Dune_util.Execution_env + module Feature_flags = Feature_flags (* the configuration file use the same version numbers as dune-project files for simplicity *) @@ -289,9 +290,14 @@ module Dune_config = struct ; concurrency = (if Execution_env.inside_dune then Fixed 1 else Auto) ; terminal_persistence = Clear_on_rebuild ; sandboxing_preference = [] - ; cache_enabled = `Disabled - ; cache_reproducibility_check = Skip - ; cache_storage_mode = None + ; cache_enabled = + (if Feature_flags.cache_enabled_by_default then `Enabled else `Disabled) + ; cache_reproducibility_check = + (if Feature_flags.cache_enabled_by_default then Check else Skip) + ; cache_storage_mode = + (if Feature_flags.cache_enabled_by_default + then Some (Dune_cache_storage.Mode.default ()) + else None) ; action_stdout_on_success = Print ; action_stderr_on_success = Print ; experimental = [] diff --git a/src/dune_config_file/feature_flags.ml b/src/dune_config_file/feature_flags.ml new file mode 100644 index 00000000000..f9521684aa3 --- /dev/null +++ b/src/dune_config_file/feature_flags.ml @@ -0,0 +1 @@ +let cache_enabled_by_default = false diff --git a/test/blackbox-tests/test-cases/default-cache.t b/test/blackbox-tests/test-cases/default-cache.t new file mode 100644 index 00000000000..03c9c849425 --- /dev/null +++ b/test/blackbox-tests/test-cases/default-cache.t @@ -0,0 +1,34 @@ +The dune cache should be enabled by 'default' +(not by default on main branch since it's a feature flag) + $ export DUNE_CACHE=enabled + $ echo "(lang dune 3.16)" > dune-project + + $ cat > dune << EOF + > (library + > (name foo)) + > EOF + + $ cat > foo.ml << EOF + > let f x y = x + y + > EOF + +Set up cache directory + $ export DUNE_CACHE_ROOT=$(pwd)/dune_test_cache + $ mkdir $DUNE_CACHE_ROOT + + $ DUNE_CACHE=disabled dune build + $ ls $DUNE_CACHE_ROOT +We have not written anything to the cache yet. + +Change source files to force a recompilation + $ cat > foo.ml << EOF + > let f x y = x - y + > EOF + + $ dune build + $ ls $DUNE_CACHE_ROOT + files + meta + temp + values +Cache has been written to! From 0f79e1fa3c0cb214b8f0050e322d175b0809ca28 Mon Sep 17 00:00:00 2001 From: Ambre Austen Suhamy Date: Fri, 2 Aug 2024 16:52:37 +0200 Subject: [PATCH 2/5] Added env var CACHE_USER_RULES, trying to use it with default cache enabled Signed-off-by: Ambre Austen Suhamy Signed-off-by: Marek Kubica --- bin/common.ml | 17 +++++++++++++ src/dune_cache/config.ml | 1 + src/dune_cache/config.mli | 1 + src/dune_cache/shared.ml | 31 +++++++++++------------ src/dune_config_file/dune_config_file.ml | 20 ++++++++------- src/dune_config_file/dune_config_file.mli | 1 + src/dune_config_file/feature_flags.ml | 1 - src/dune_engine/action.ml | 2 +- src/dune_engine/action.mli | 2 +- 9 files changed, 48 insertions(+), 28 deletions(-) delete mode 100644 src/dune_config_file/feature_flags.ml diff --git a/bin/common.ml b/bin/common.ml index e0515ed5738..02f04af1e90 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -419,6 +419,21 @@ let shared_with_config_file = value & opt (some (enum Config.Toggle.all)) None & info [ "cache" ] ~docs ~env:(Cmd.Env.info ~doc "DUNE_CACHE") ~doc) + and+ cache_user_rules = + let doc = + Printf.sprintf + "Enable or disable caching user-created rules (%s). Default is `%s'." + (Arg.doc_alts_enum Config.Toggle.all) + (Config.Toggle.to_string Dune_config.default.cache_user_rules) + in + Arg.( + value + & opt (some (enum Config.Toggle.all)) None + & info + [ "cache-user-rules" ] + ~docs + ~env:(Cmd.Env.info ~doc "DUNE_CACHE_USER_RULES") + ~doc) and+ cache_storage_mode = let doc = Printf.sprintf @@ -481,6 +496,7 @@ let shared_with_config_file = ; sandboxing_preference = Option.map sandboxing_preference ~f:(fun x -> [ x ]) ; terminal_persistence ; cache_enabled + ; cache_user_rules ; cache_reproducibility_check = Option.map cache_check_probability @@ -1205,6 +1221,7 @@ let init (builder : Builder.t) = Enabled { storage_mode = Option.value config.cache_storage_mode ~default:Hardlink ; reproducibility_check = config.cache_reproducibility_check + ; cache_user_rules = config.cache_user_rules = `Enabled } in Log.info [ Pp.textf "Shared cache: %s" (Config.Toggle.to_string config.cache_enabled) ]; diff --git a/src/dune_cache/config.ml b/src/dune_cache/config.ml index e14ab5f7ae4..de3264e786c 100644 --- a/src/dune_cache/config.ml +++ b/src/dune_cache/config.ml @@ -43,4 +43,5 @@ type t = | Enabled of { storage_mode : Dune_cache_storage.Mode.t ; reproducibility_check : Reproducibility_check.t + ; cache_user_rules : bool } diff --git a/src/dune_cache/config.mli b/src/dune_cache/config.mli index e7461c5baa3..fc33dff0bba 100644 --- a/src/dune_cache/config.mli +++ b/src/dune_cache/config.mli @@ -47,4 +47,5 @@ type t = | Enabled of { storage_mode : Dune_cache_storage.Mode.t ; reproducibility_check : Reproducibility_check.t + ; cache_user_rules : bool } diff --git a/src/dune_cache/shared.ml b/src/dune_cache/shared.ml index 21577b83efb..15cdc9eb426 100644 --- a/src/dune_cache/shared.ml +++ b/src/dune_cache/shared.ml @@ -65,28 +65,27 @@ struct | Error exn -> Miss (Error (Printexc.to_string exn)) ;; - let lookup_impl ~rule_digest ~targets = + let lookup_impl ~can_go_in_shared_cache ~rule_digest ~targets = match config with | Disabled -> Fiber.return (Hit_or_miss.Miss Miss_reason.Cache_disabled) - | Enabled { storage_mode = mode; reproducibility_check } -> - (match Config.Reproducibility_check.sample reproducibility_check with - | true -> - (* CR-someday amokhov: Here we re-execute the rule, as in Jenga. To make - [check_probability] more meaningful, we could first make sure that - the shared cache actually does contain an entry for [rule_digest]. *) - Fiber.return (Hit_or_miss.Miss Miss_reason.Rerunning_for_reproducibility_check) - | false -> try_to_restore_from_shared_cache ~mode ~rule_digest ~targets) + | Enabled { storage_mode = mode; reproducibility_check; cache_user_rules } -> + if can_go_in_shared_cache || cache_user_rules + then ( + match Config.Reproducibility_check.sample reproducibility_check with + | true -> + (* CR-someday amokhov: Here we re-execute the rule, as in Jenga. To make + [check_probability] more meaningful, we could first make sure that + the shared cache actually does contain an entry for [rule_digest]. *) + Fiber.return (Hit_or_miss.Miss Miss_reason.Rerunning_for_reproducibility_check) + | false -> try_to_restore_from_shared_cache ~mode ~rule_digest ~targets) + else Fiber.return (Hit_or_miss.Miss Miss_reason.Cannot_go_in_shared_cache) ;; let lookup ~can_go_in_shared_cache ~rule_digest ~targets : Digest.t Targets.Produced.t option Fiber.t = let open Fiber.O in - let+ result = - match can_go_in_shared_cache with - | false -> Fiber.return (Hit_or_miss.Miss Miss_reason.Cannot_go_in_shared_cache) - | true -> lookup_impl ~rule_digest ~targets - in + let+ result = lookup_impl ~can_go_in_shared_cache ~rule_digest ~targets in match result with | Hit result -> Some result | Miss reason -> @@ -277,8 +276,8 @@ struct : Digest.t Targets.Produced.t Fiber.t = match config with - | Enabled { storage_mode = mode; reproducibility_check = _ } - when can_go_in_shared_cache -> + | Enabled { storage_mode = mode; reproducibility_check = _; cache_user_rules } + when can_go_in_shared_cache || cache_user_rules -> let open Fiber.O in let+ produced_targets_with_digests = try_to_store_to_shared_cache ~mode ~rule_digest ~produced_targets ~action diff --git a/src/dune_config_file/dune_config_file.ml b/src/dune_config_file/dune_config_file.ml index a9b83ef5a0c..915e029833c 100644 --- a/src/dune_config_file/dune_config_file.ml +++ b/src/dune_config_file/dune_config_file.ml @@ -11,7 +11,6 @@ module Dune_config = struct module Log = Dune_util.Log module Config = Dune_config.Config module Execution_env = Dune_util.Execution_env - module Feature_flags = Feature_flags (* the configuration file use the same version numbers as dune-project files for simplicity *) @@ -133,6 +132,7 @@ module Dune_config = struct ; terminal_persistence : Terminal_persistence.t field ; sandboxing_preference : Sandboxing_preference.t field ; cache_enabled : Config.Toggle.t field + ; cache_user_rules : Config.Toggle.t field ; cache_reproducibility_check : Dune_cache.Config.Reproducibility_check.t field ; cache_storage_mode : Cache.Storage_mode.t field ; action_stdout_on_success : Action_output_on_success.t field @@ -157,6 +157,7 @@ module Dune_config = struct ; terminal_persistence = field a.terminal_persistence b.terminal_persistence ; sandboxing_preference = field a.sandboxing_preference b.sandboxing_preference ; cache_enabled = field a.cache_enabled b.cache_enabled + ; cache_user_rules = field a.cache_user_rules b.cache_user_rules ; cache_reproducibility_check = field a.cache_reproducibility_check b.cache_reproducibility_check ; cache_storage_mode = field a.cache_storage_mode b.cache_storage_mode @@ -183,6 +184,7 @@ module Dune_config = struct ; terminal_persistence ; sandboxing_preference ; cache_enabled + ; cache_user_rules ; cache_reproducibility_check ; cache_storage_mode ; action_stdout_on_success @@ -197,6 +199,7 @@ module Dune_config = struct ; ( "sandboxing_preference" , field (Dyn.list Sandbox_mode.to_dyn) sandboxing_preference ) ; "cache_enabled", field Config.Toggle.to_dyn cache_enabled + ; "cache_user_rules", field Config.Toggle.to_dyn cache_user_rules ; ( "cache_reproducibility_check" , field Dune_cache.Config.Reproducibility_check.to_dyn @@ -225,6 +228,7 @@ module Dune_config = struct ; terminal_persistence = None ; sandboxing_preference = None ; cache_enabled = None + ; cache_user_rules = None ; cache_reproducibility_check = None ; cache_storage_mode = None ; action_stdout_on_success = None @@ -290,14 +294,10 @@ module Dune_config = struct ; concurrency = (if Execution_env.inside_dune then Fixed 1 else Auto) ; terminal_persistence = Clear_on_rebuild ; sandboxing_preference = [] - ; cache_enabled = - (if Feature_flags.cache_enabled_by_default then `Enabled else `Disabled) - ; cache_reproducibility_check = - (if Feature_flags.cache_enabled_by_default then Check else Skip) - ; cache_storage_mode = - (if Feature_flags.cache_enabled_by_default - then Some (Dune_cache_storage.Mode.default ()) - else None) + ; cache_enabled = `Enabled + ; cache_user_rules = `Disabled + ; cache_reproducibility_check = Check + ; cache_storage_mode = Some (Dune_cache_storage.Mode.default ()) ; action_stdout_on_success = Print ; action_stderr_on_success = Print ; experimental = [] @@ -317,6 +317,7 @@ module Dune_config = struct and+ sandboxing_preference = field_o "sandboxing_preference" (1, 0) Sandboxing_preference.decode and+ cache_enabled = field_o "cache" (2, 0) (enum Config.Toggle.all) + and+ cache_user_rules = field_o "cache-user-rules" (2, 0) (enum Config.Toggle.all) and+ _cache_transport_unused_since_3_0 = field_o "cache-transport" @@ -379,6 +380,7 @@ module Dune_config = struct ; terminal_persistence ; sandboxing_preference ; cache_enabled + ; cache_user_rules ; cache_reproducibility_check ; cache_storage_mode ; action_stdout_on_success diff --git a/src/dune_config_file/dune_config_file.mli b/src/dune_config_file/dune_config_file.mli index 0f33225084b..9586b058e39 100644 --- a/src/dune_config_file/dune_config_file.mli +++ b/src/dune_config_file/dune_config_file.mli @@ -52,6 +52,7 @@ module Dune_config : sig ; terminal_persistence : Terminal_persistence.t field ; sandboxing_preference : Sandboxing_preference.t field ; cache_enabled : Config.Toggle.t field + ; cache_user_rules : Config.Toggle.t field ; cache_reproducibility_check : Dune_cache.Config.Reproducibility_check.t field ; cache_storage_mode : Cache.Storage_mode.t field ; action_stdout_on_success : Action_output_on_success.t field diff --git a/src/dune_config_file/feature_flags.ml b/src/dune_config_file/feature_flags.ml deleted file mode 100644 index f9521684aa3..00000000000 --- a/src/dune_config_file/feature_flags.ml +++ /dev/null @@ -1 +0,0 @@ -let cache_enabled_by_default = false diff --git a/src/dune_engine/action.ml b/src/dune_engine/action.ml index 2762e900fce..eae5c4efc14 100644 --- a/src/dune_engine/action.ml +++ b/src/dune_engine/action.ml @@ -336,7 +336,7 @@ module Full = struct let make ?(env = Env.empty) ?(locks = []) - ?(can_go_in_shared_cache = true) + ?(can_go_in_shared_cache = false) ?(sandbox = Sandbox_config.default) action = diff --git a/src/dune_engine/action.mli b/src/dune_engine/action.mli index 6719d1be3d8..54a5fcaff65 100644 --- a/src/dune_engine/action.mli +++ b/src/dune_engine/action.mli @@ -152,7 +152,7 @@ module Full : sig val make : ?env:Env.t (** default [Env.empty] *) -> ?locks:Path.t list (** default [[]] *) - -> ?can_go_in_shared_cache:bool (** default [true] *) + -> ?can_go_in_shared_cache:bool (** default [false] *) -> ?sandbox:Sandbox_config.t (** default [Sandbox_config.default] *) -> action -> t From d0f716ecd39bba2c0c69c71e07daf4ae79ae467c Mon Sep 17 00:00:00 2001 From: Ambre Austen Suhamy Date: Fri, 2 Aug 2024 16:59:35 +0200 Subject: [PATCH 3/5] Updated test case to reflect new behaviour Signed-off-by: Marek Kubica --- test/blackbox-tests/test-cases/default-cache.t | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/test/blackbox-tests/test-cases/default-cache.t b/test/blackbox-tests/test-cases/default-cache.t index 03c9c849425..6744bbb4110 100644 --- a/test/blackbox-tests/test-cases/default-cache.t +++ b/test/blackbox-tests/test-cases/default-cache.t @@ -1,6 +1,4 @@ -The dune cache should be enabled by 'default' -(not by default on main branch since it's a feature flag) - $ export DUNE_CACHE=enabled +The dune cache should be enabled by default $ echo "(lang dune 3.16)" > dune-project $ cat > dune << EOF From db64c348762860f1675783e5ef8b4daf591e4d19 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Thu, 8 Aug 2024 15:21:58 +0200 Subject: [PATCH 4/5] Incorporate review comments Signed-off-by: Marek Kubica --- bin/common.ml | 34 +++++++++---------- src/dune_cache/config.ml | 1 - src/dune_cache/config.mli | 1 - src/dune_cache/shared.ml | 31 +++++++++-------- src/dune_cache_storage/layout.ml | 8 +++-- src/dune_cache_storage/layout.mli | 7 ++-- src/dune_config_file/dune_config_file.ml | 10 +----- src/dune_config_file/dune_config_file.mli | 1 - src/dune_engine/action.ml | 2 +- src/dune_engine/action.mli | 3 +- src/dune_engine/build_config.ml | 5 --- src/dune_engine/clflags.ml | 1 + src/dune_engine/clflags.mli | 3 ++ src/dune_rules/dune | 1 + src/dune_rules/main.ml | 26 ++++++++++++++ src/dune_rules/simple_rules.ml | 2 +- .../blackbox-tests/test-cases/default-cache.t | 11 +++--- .../directory-targets/cache-file-and-dir.t | 1 + .../directory-targets/cache-shared-subdir.t | 1 + .../test-cases/directory-targets/cache.t | 1 + .../test-cases/dune-cache/config.t | 1 + .../test-cases/dune-cache/dedup.t | 1 + .../dune-cache/missing-cache-entries.t | 1 + .../test-cases/dune-cache/mode-copy.t | 1 + .../test-cases/dune-cache/mode-hardlink.t | 1 + .../test-cases/dune-cache/readonly-fs.t | 22 ++++++++---- .../test-cases/dune-cache/repro-check.t | 1 + .../test-cases/dune-cache/size.t/run.t | 1 + .../test-cases/dune-cache/symlink.t | 1 + .../test-cases/dune-cache/trim.t | 1 + .../test-cases/pkg/toolchain-installation.t | 4 +-- .../dune_config_file/dune_config_test.ml | 8 ++--- 32 files changed, 118 insertions(+), 75 deletions(-) diff --git a/bin/common.ml b/bin/common.ml index 02f04af1e90..9bcc02d61b4 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -419,21 +419,6 @@ let shared_with_config_file = value & opt (some (enum Config.Toggle.all)) None & info [ "cache" ] ~docs ~env:(Cmd.Env.info ~doc "DUNE_CACHE") ~doc) - and+ cache_user_rules = - let doc = - Printf.sprintf - "Enable or disable caching user-created rules (%s). Default is `%s'." - (Arg.doc_alts_enum Config.Toggle.all) - (Config.Toggle.to_string Dune_config.default.cache_user_rules) - in - Arg.( - value - & opt (some (enum Config.Toggle.all)) None - & info - [ "cache-user-rules" ] - ~docs - ~env:(Cmd.Env.info ~doc "DUNE_CACHE_USER_RULES") - ~doc) and+ cache_storage_mode = let doc = Printf.sprintf @@ -496,7 +481,6 @@ let shared_with_config_file = ; sandboxing_preference = Option.map sandboxing_preference ~f:(fun x -> [ x ]) ; terminal_persistence ; cache_enabled - ; cache_user_rules ; cache_reproducibility_check = Option.map cache_check_probability @@ -599,6 +583,7 @@ module Builder = struct ; file_watcher : Dune_engine.Scheduler.Run.file_watcher ; workspace_config : Dune_rules.Workspace.Clflags.t ; cache_debug_flags : Dune_engine.Cache_debug_flags.t + ; cache_rules_default : bool ; report_errors_config : Dune_engine.Report_errors_config.t ; separate_error_messages : bool ; stop_on_first_error : bool @@ -948,6 +933,20 @@ module Builder = struct useful for Dune developers to make Dune tests of the digest cache more \ reproducible.") and+ cache_debug_flags = cache_debug_flags_term + and+ cache_rules_default = + let default = + Dune_lang.Toggle.of_bool !Dune_engine.Clflags.can_go_in_shared_cache_default + in + let doc = + Printf.sprintf + "Enable or disable caching rules (%s). Default is `%s'." + (Arg.doc_alts_enum Config.Toggle.all) + (Config.Toggle.to_string default) + in + Arg.( + value + & opt (enum Config.Toggle.all) default + & info [ "cache-rules" ] ~docs ~env:(Cmd.Env.info ~doc "DUNE_CACHE_RULES") ~doc) and+ report_errors_config = Arg.( value @@ -1024,6 +1023,7 @@ module Builder = struct ; config_from_config_file } ; cache_debug_flags + ; cache_rules_default = Dune_lang.Toggle.enabled cache_rules_default ; report_errors_config ; separate_error_messages ; stop_on_first_error @@ -1221,7 +1221,6 @@ let init (builder : Builder.t) = Enabled { storage_mode = Option.value config.cache_storage_mode ~default:Hardlink ; reproducibility_check = config.cache_reproducibility_check - ; cache_user_rules = config.cache_user_rules = `Enabled } in Log.info [ Pp.textf "Shared cache: %s" (Config.Toggle.to_string config.cache_enabled) ]; @@ -1258,6 +1257,7 @@ let init (builder : Builder.t) = Dune_rules.Clflags.ignore_lock_dir := c.builder.ignore_lock_dir; Dune_rules.Clflags.on_missing_dune_project_file := if c.builder.require_dune_project_file then Error else Warn; + Dune_engine.Clflags.can_go_in_shared_cache_default := c.builder.cache_rules_default; Log.info [ Pp.textf "Workspace root: %s" diff --git a/src/dune_cache/config.ml b/src/dune_cache/config.ml index de3264e786c..e14ab5f7ae4 100644 --- a/src/dune_cache/config.ml +++ b/src/dune_cache/config.ml @@ -43,5 +43,4 @@ type t = | Enabled of { storage_mode : Dune_cache_storage.Mode.t ; reproducibility_check : Reproducibility_check.t - ; cache_user_rules : bool } diff --git a/src/dune_cache/config.mli b/src/dune_cache/config.mli index fc33dff0bba..e7461c5baa3 100644 --- a/src/dune_cache/config.mli +++ b/src/dune_cache/config.mli @@ -47,5 +47,4 @@ type t = | Enabled of { storage_mode : Dune_cache_storage.Mode.t ; reproducibility_check : Reproducibility_check.t - ; cache_user_rules : bool } diff --git a/src/dune_cache/shared.ml b/src/dune_cache/shared.ml index 15cdc9eb426..21577b83efb 100644 --- a/src/dune_cache/shared.ml +++ b/src/dune_cache/shared.ml @@ -65,27 +65,28 @@ struct | Error exn -> Miss (Error (Printexc.to_string exn)) ;; - let lookup_impl ~can_go_in_shared_cache ~rule_digest ~targets = + let lookup_impl ~rule_digest ~targets = match config with | Disabled -> Fiber.return (Hit_or_miss.Miss Miss_reason.Cache_disabled) - | Enabled { storage_mode = mode; reproducibility_check; cache_user_rules } -> - if can_go_in_shared_cache || cache_user_rules - then ( - match Config.Reproducibility_check.sample reproducibility_check with - | true -> - (* CR-someday amokhov: Here we re-execute the rule, as in Jenga. To make - [check_probability] more meaningful, we could first make sure that - the shared cache actually does contain an entry for [rule_digest]. *) - Fiber.return (Hit_or_miss.Miss Miss_reason.Rerunning_for_reproducibility_check) - | false -> try_to_restore_from_shared_cache ~mode ~rule_digest ~targets) - else Fiber.return (Hit_or_miss.Miss Miss_reason.Cannot_go_in_shared_cache) + | Enabled { storage_mode = mode; reproducibility_check } -> + (match Config.Reproducibility_check.sample reproducibility_check with + | true -> + (* CR-someday amokhov: Here we re-execute the rule, as in Jenga. To make + [check_probability] more meaningful, we could first make sure that + the shared cache actually does contain an entry for [rule_digest]. *) + Fiber.return (Hit_or_miss.Miss Miss_reason.Rerunning_for_reproducibility_check) + | false -> try_to_restore_from_shared_cache ~mode ~rule_digest ~targets) ;; let lookup ~can_go_in_shared_cache ~rule_digest ~targets : Digest.t Targets.Produced.t option Fiber.t = let open Fiber.O in - let+ result = lookup_impl ~can_go_in_shared_cache ~rule_digest ~targets in + let+ result = + match can_go_in_shared_cache with + | false -> Fiber.return (Hit_or_miss.Miss Miss_reason.Cannot_go_in_shared_cache) + | true -> lookup_impl ~rule_digest ~targets + in match result with | Hit result -> Some result | Miss reason -> @@ -276,8 +277,8 @@ struct : Digest.t Targets.Produced.t Fiber.t = match config with - | Enabled { storage_mode = mode; reproducibility_check = _; cache_user_rules } - when can_go_in_shared_cache || cache_user_rules -> + | Enabled { storage_mode = mode; reproducibility_check = _ } + when can_go_in_shared_cache -> let open Fiber.O in let+ produced_targets_with_digests = try_to_store_to_shared_cache ~mode ~rule_digest ~produced_targets ~action diff --git a/src/dune_cache_storage/layout.ml b/src/dune_cache_storage/layout.ml index 4df37baaeaa..7951d5287a5 100644 --- a/src/dune_cache_storage/layout.ml +++ b/src/dune_cache_storage/layout.ml @@ -82,7 +82,9 @@ let value_storage_dir = Versioned.value_storage_dir Version.Value.current let value_path = Versioned.value_path Version.Value.current let create_cache_directories () = - List.iter - [ temp_dir; metadata_storage_dir; file_storage_dir; value_storage_dir ] - ~f:(fun path -> ignore (Fpath.mkdir_p (Path.to_string path) : Fpath.mkdir_p_result)) + [ temp_dir; metadata_storage_dir; file_storage_dir; value_storage_dir ] + |> Result.List.iter ~f:(fun path -> + match Fpath.mkdir_p (Path.to_string path) with + | Already_exists | Created -> Ok () + | exception Unix.Unix_error (e, _, _) -> Error (path, e)) ;; diff --git a/src/dune_cache_storage/layout.mli b/src/dune_cache_storage/layout.mli index 560c7f76795..2ab381e0b23 100644 --- a/src/dune_cache_storage/layout.mli +++ b/src/dune_cache_storage/layout.mli @@ -12,8 +12,11 @@ open Import val root_dir : Path.t (** Create a few subdirectories in [root_dir]. We expose this function because - we don't want to modify the file system when the cache is disabled. *) -val create_cache_directories : unit -> unit + we don't want to modify the file system when the cache is disabled. + + Returns whether creation has succeeded or in the case of error which directory + could not be created. *) +val create_cache_directories : unit -> (unit, Path.t * Unix.error) result (** This directory stores metadata files, one per each historically executed build rule or output-producing action. (While this is a convenient mental diff --git a/src/dune_config_file/dune_config_file.ml b/src/dune_config_file/dune_config_file.ml index 915e029833c..ba01baaff28 100644 --- a/src/dune_config_file/dune_config_file.ml +++ b/src/dune_config_file/dune_config_file.ml @@ -132,7 +132,6 @@ module Dune_config = struct ; terminal_persistence : Terminal_persistence.t field ; sandboxing_preference : Sandboxing_preference.t field ; cache_enabled : Config.Toggle.t field - ; cache_user_rules : Config.Toggle.t field ; cache_reproducibility_check : Dune_cache.Config.Reproducibility_check.t field ; cache_storage_mode : Cache.Storage_mode.t field ; action_stdout_on_success : Action_output_on_success.t field @@ -157,7 +156,6 @@ module Dune_config = struct ; terminal_persistence = field a.terminal_persistence b.terminal_persistence ; sandboxing_preference = field a.sandboxing_preference b.sandboxing_preference ; cache_enabled = field a.cache_enabled b.cache_enabled - ; cache_user_rules = field a.cache_user_rules b.cache_user_rules ; cache_reproducibility_check = field a.cache_reproducibility_check b.cache_reproducibility_check ; cache_storage_mode = field a.cache_storage_mode b.cache_storage_mode @@ -184,7 +182,6 @@ module Dune_config = struct ; terminal_persistence ; sandboxing_preference ; cache_enabled - ; cache_user_rules ; cache_reproducibility_check ; cache_storage_mode ; action_stdout_on_success @@ -199,7 +196,6 @@ module Dune_config = struct ; ( "sandboxing_preference" , field (Dyn.list Sandbox_mode.to_dyn) sandboxing_preference ) ; "cache_enabled", field Config.Toggle.to_dyn cache_enabled - ; "cache_user_rules", field Config.Toggle.to_dyn cache_user_rules ; ( "cache_reproducibility_check" , field Dune_cache.Config.Reproducibility_check.to_dyn @@ -228,7 +224,6 @@ module Dune_config = struct ; terminal_persistence = None ; sandboxing_preference = None ; cache_enabled = None - ; cache_user_rules = None ; cache_reproducibility_check = None ; cache_storage_mode = None ; action_stdout_on_success = None @@ -295,8 +290,7 @@ module Dune_config = struct ; terminal_persistence = Clear_on_rebuild ; sandboxing_preference = [] ; cache_enabled = `Enabled - ; cache_user_rules = `Disabled - ; cache_reproducibility_check = Check + ; cache_reproducibility_check = Skip ; cache_storage_mode = Some (Dune_cache_storage.Mode.default ()) ; action_stdout_on_success = Print ; action_stderr_on_success = Print @@ -317,7 +311,6 @@ module Dune_config = struct and+ sandboxing_preference = field_o "sandboxing_preference" (1, 0) Sandboxing_preference.decode and+ cache_enabled = field_o "cache" (2, 0) (enum Config.Toggle.all) - and+ cache_user_rules = field_o "cache-user-rules" (2, 0) (enum Config.Toggle.all) and+ _cache_transport_unused_since_3_0 = field_o "cache-transport" @@ -380,7 +373,6 @@ module Dune_config = struct ; terminal_persistence ; sandboxing_preference ; cache_enabled - ; cache_user_rules ; cache_reproducibility_check ; cache_storage_mode ; action_stdout_on_success diff --git a/src/dune_config_file/dune_config_file.mli b/src/dune_config_file/dune_config_file.mli index 9586b058e39..0f33225084b 100644 --- a/src/dune_config_file/dune_config_file.mli +++ b/src/dune_config_file/dune_config_file.mli @@ -52,7 +52,6 @@ module Dune_config : sig ; terminal_persistence : Terminal_persistence.t field ; sandboxing_preference : Sandboxing_preference.t field ; cache_enabled : Config.Toggle.t field - ; cache_user_rules : Config.Toggle.t field ; cache_reproducibility_check : Dune_cache.Config.Reproducibility_check.t field ; cache_storage_mode : Cache.Storage_mode.t field ; action_stdout_on_success : Action_output_on_success.t field diff --git a/src/dune_engine/action.ml b/src/dune_engine/action.ml index eae5c4efc14..dd06e73575f 100644 --- a/src/dune_engine/action.ml +++ b/src/dune_engine/action.ml @@ -336,7 +336,7 @@ module Full = struct let make ?(env = Env.empty) ?(locks = []) - ?(can_go_in_shared_cache = false) + ?(can_go_in_shared_cache = !Clflags.can_go_in_shared_cache_default) ?(sandbox = Sandbox_config.default) action = diff --git a/src/dune_engine/action.mli b/src/dune_engine/action.mli index 54a5fcaff65..ddd77b02e0c 100644 --- a/src/dune_engine/action.mli +++ b/src/dune_engine/action.mli @@ -152,7 +152,8 @@ module Full : sig val make : ?env:Env.t (** default [Env.empty] *) -> ?locks:Path.t list (** default [[]] *) - -> ?can_go_in_shared_cache:bool (** default [false] *) + -> ?can_go_in_shared_cache:bool + (** default [!Clflags.can_fo_in_shared_cache_default] *) -> ?sandbox:Sandbox_config.t (** default [Sandbox_config.default] *) -> action -> t diff --git a/src/dune_engine/build_config.ml b/src/dune_engine/build_config.ml index 584f7d6df41..742bf8c9fc6 100644 --- a/src/dune_engine/build_config.ml +++ b/src/dune_engine/build_config.ml @@ -106,11 +106,6 @@ let set contexts ~f:(fun ((ctx : Build_context.t), ctx_type) -> ctx.name, (ctx, ctx_type))) in - let () = - match (cache_config : Dune_cache.Config.t) with - | Disabled -> () - | Enabled _ -> Dune_cache_storage.Layout.create_cache_directories () - in Fdecl.set t { contexts diff --git a/src/dune_engine/clflags.ml b/src/dune_engine/clflags.ml index c7358890b74..99119b4b107 100644 --- a/src/dune_engine/clflags.ml +++ b/src/dune_engine/clflags.ml @@ -19,3 +19,4 @@ let promote = ref None let force = ref false let always_show_command_line = ref false let display = ref Display.Quiet +let can_go_in_shared_cache_default = ref false diff --git a/src/dune_engine/clflags.mli b/src/dune_engine/clflags.mli index e5edb0ea22c..15012375ba8 100644 --- a/src/dune_engine/clflags.mli +++ b/src/dune_engine/clflags.mli @@ -34,3 +34,6 @@ val always_show_command_line : bool ref (** The display mode *) val display : Display.t ref + +(** Whether actions are cacheable by default, default [false] *) +val can_go_in_shared_cache_default : bool ref diff --git a/src/dune_rules/dune b/src/dune_rules/dune index 2d75571cb3c..dfcc3d893ea 100644 --- a/src/dune_rules/dune +++ b/src/dune_rules/dune @@ -33,6 +33,7 @@ build_path_prefix_map dune_engine dune_vcs + dune_cache_storage dune_config dune_config_file dune_findlib diff --git a/src/dune_rules/main.ml b/src/dune_rules/main.ml index 5d83235ea35..56d2224671b 100644 --- a/src/dune_rules/main.ml +++ b/src/dune_rules/main.ml @@ -75,6 +75,32 @@ let init let download ~rule_digest:_ = Fiber.return () end) in + let cache_config = + match cache_config with + | Disabled -> cache_config + | Enabled _ -> + (match Dune_cache_storage.Layout.create_cache_directories () with + | Ok () -> cache_config + | Error (path, exn) -> + (* temporary hack: make sure not to break the line by + disabling the line break *) + let original_margin = Format.get_margin () in + Fun.protect + ~finally:(fun () -> Format.set_margin original_margin) + (fun () -> + Format.set_margin Stdlib.Int.max_int; + User_warning.emit + ~hints: + [ Pp.textf + "Make sure the directory %s can be created" + (Path.to_string path) + ] + [ Pp.textf + "Cache directories could not be created: %s; disabling cache" + (Unix.error_message exn) + ]); + Disabled) + in Build_config.set ~stats ~sandboxing_preference diff --git a/src/dune_rules/simple_rules.ml b/src/dune_rules/simple_rules.ml index 7823eb60a8f..d5ffa61a30f 100644 --- a/src/dune_rules/simple_rules.ml +++ b/src/dune_rules/simple_rules.ml @@ -63,7 +63,7 @@ let add_user_rule sctx ~dir ~(rule : Rule_conf.t) - ~(action : _ Action_builder.With_targets.t) + ~(action : Action.Full.t Action_builder.With_targets.t) ~expander = let action = diff --git a/test/blackbox-tests/test-cases/default-cache.t b/test/blackbox-tests/test-cases/default-cache.t index 6744bbb4110..7404edfc03a 100644 --- a/test/blackbox-tests/test-cases/default-cache.t +++ b/test/blackbox-tests/test-cases/default-cache.t @@ -1,5 +1,6 @@ The dune cache should be enabled by default - $ echo "(lang dune 3.16)" > dune-project + + $ echo "(lang dune 3.17)" > dune-project $ cat > dune << EOF > (library @@ -11,22 +12,24 @@ The dune cache should be enabled by default > EOF Set up cache directory + $ export DUNE_CACHE_ROOT=$(pwd)/dune_test_cache $ mkdir $DUNE_CACHE_ROOT - $ DUNE_CACHE=disabled dune build $ ls $DUNE_CACHE_ROOT + We have not written anything to the cache yet. Change source files to force a recompilation + $ cat > foo.ml << EOF > let f x y = x - y > EOF - $ dune build - $ ls $DUNE_CACHE_ROOT + $ ls $DUNE_CACHE_ROOT | sort files meta temp values + Cache has been written to! diff --git a/test/blackbox-tests/test-cases/directory-targets/cache-file-and-dir.t b/test/blackbox-tests/test-cases/directory-targets/cache-file-and-dir.t index 5f6f9ae1d7b..580e2513176 100644 --- a/test/blackbox-tests/test-cases/directory-targets/cache-file-and-dir.t +++ b/test/blackbox-tests/test-cases/directory-targets/cache-file-and-dir.t @@ -2,6 +2,7 @@ This checks what happens when a file available in the cache is used in a directo $ export DUNE_CACHE_ROOT=$PWD/.cache $ export DUNE_CACHE=enabled + $ export DUNE_CACHE_RULES=enabled $ . ./helpers.sh $ cat > dune-project << EOF diff --git a/test/blackbox-tests/test-cases/directory-targets/cache-shared-subdir.t b/test/blackbox-tests/test-cases/directory-targets/cache-shared-subdir.t index fc7c7cb3065..8d18166a5d2 100644 --- a/test/blackbox-tests/test-cases/directory-targets/cache-shared-subdir.t +++ b/test/blackbox-tests/test-cases/directory-targets/cache-shared-subdir.t @@ -1,6 +1,7 @@ We create 2 directory targets which share a whole subdirectory. $ export DUNE_CACHE_ROOT=$PWD/.cache + $ export DUNE_CACHE_RULES=enabled $ export DUNE_CACHE=enabled $ . ./helpers.sh diff --git a/test/blackbox-tests/test-cases/directory-targets/cache.t b/test/blackbox-tests/test-cases/directory-targets/cache.t index dc84fb3a52c..5dcbcf06252 100644 --- a/test/blackbox-tests/test-cases/directory-targets/cache.t +++ b/test/blackbox-tests/test-cases/directory-targets/cache.t @@ -1,6 +1,7 @@ We test that directory targets can go in the shared cache. See #8067. $ export DUNE_CACHE_ROOT=$PWD/.cache + $ export DUNE_CACHE_RULES=enabled $ export DUNE_CACHE=enabled In project a, we create a rule with a directory target. The script that creates diff --git a/test/blackbox-tests/test-cases/dune-cache/config.t b/test/blackbox-tests/test-cases/dune-cache/config.t index b64aae09346..ad9cce8bb43 100644 --- a/test/blackbox-tests/test-cases/dune-cache/config.t +++ b/test/blackbox-tests/test-cases/dune-cache/config.t @@ -26,6 +26,7 @@ Check that old cache configuration format works fine with an old language Test that DUNE_CACHE_ROOT can be used to control the cache location $ export DUNE_CACHE_ROOT=$PWD/.cache + $ export DUNE_CACHE_RULES=enabled Build succeeds and the 'copy' mode is respected diff --git a/test/blackbox-tests/test-cases/dune-cache/dedup.t b/test/blackbox-tests/test-cases/dune-cache/dedup.t index ba9e13e383a..73b8ef5fdb5 100644 --- a/test/blackbox-tests/test-cases/dune-cache/dedup.t +++ b/test/blackbox-tests/test-cases/dune-cache/dedup.t @@ -2,6 +2,7 @@ Test deduplication of build artifacts when using Dune cache with hard links. $ export DUNE_CACHE=enabled $ export DUNE_CACHE_ROOT=$PWD/.cache + $ export DUNE_CACHE_RULES=enabled $ cat > dune-project < (lang dune 2.1) diff --git a/test/blackbox-tests/test-cases/dune-cache/missing-cache-entries.t b/test/blackbox-tests/test-cases/dune-cache/missing-cache-entries.t index 3565ab9d8ea..01b987c804d 100644 --- a/test/blackbox-tests/test-cases/dune-cache/missing-cache-entries.t +++ b/test/blackbox-tests/test-cases/dune-cache/missing-cache-entries.t @@ -1,6 +1,7 @@ Check that Dune cache can cope with missing file/metadata entries. $ export DUNE_CACHE_ROOT=$PWD/.cache + $ export DUNE_CACHE_RULES=enabled $ cat > config < (lang dune 2.1) diff --git a/test/blackbox-tests/test-cases/dune-cache/mode-copy.t b/test/blackbox-tests/test-cases/dune-cache/mode-copy.t index a12664fd980..3719e8b775f 100644 --- a/test/blackbox-tests/test-cases/dune-cache/mode-copy.t +++ b/test/blackbox-tests/test-cases/dune-cache/mode-copy.t @@ -5,6 +5,7 @@ variable, and via the [DUNE_CACHE_ROOT] variable. Here we test the former. $ export XDG_RUNTIME_DIR=$PWD/.xdg-runtime $ export XDG_CACHE_HOME=$PWD/.xdg-cache + $ export DUNE_CACHE_RULES=enabled $ cat > config < (lang dune 3.0) diff --git a/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t b/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t index ae152ca4860..2058335ff9b 100644 --- a/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t +++ b/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t @@ -5,6 +5,7 @@ variable, and via the [DUNE_CACHE_ROOT] variable. Here we test the former. $ export XDG_RUNTIME_DIR=$PWD/.xdg-runtime $ export XDG_CACHE_HOME=$PWD/.xdg-cache + $ export DUNE_CACHE_RULES=enabled $ cat > config < (lang dune 2.1) diff --git a/test/blackbox-tests/test-cases/dune-cache/readonly-fs.t b/test/blackbox-tests/test-cases/dune-cache/readonly-fs.t index c43b3fc2104..e03354f0e19 100644 --- a/test/blackbox-tests/test-cases/dune-cache/readonly-fs.t +++ b/test/blackbox-tests/test-cases/dune-cache/readonly-fs.t @@ -17,16 +17,24 @@ where Dune is supposed to store the cache: $ export DUNE_CACHE_ROOT=$(pwd)/readonly/cache-dir $ dune build - Error: - mkdir($TESTCASE_ROOT/readonly/cache-dir): Permission denied - [1] + Warning: Cache directories could not be created: Permission denied; disabling + cache + Hint: Make sure the directory + $TESTCASE_ROOT/readonly/cache-dir/temp + can be created Likewise, this should also happen if the location is set via XDG variables. $ unset DUNE_CACHE_ROOT $ export XDG_CACHE_HOME=$(pwd)/readonly/xdg-cache-dir + $ export DUNE_CONFIG__SKIP_LINE_BREAK=enabled - $ dune build - Error: - mkdir($TESTCASE_ROOT/readonly/xdg-cache-dir): Permission denied - [1] + $ dune build 2>&1 | sed 's/created: .*;/created: $REASON:/' + Warning: Cache directories could not be created: $REASON: disabling cache + Hint: Make sure the directory $TESTCASE_ROOT/readonly/xdg-cache-dir/dune/db/temp can be created + + $ HOME=/homeless-shelter + $ unset XDG_CACHE_HOME + $ dune build 2>&1 | sed 's/created: .*;/created: $REASON:/' + Warning: Cache directories could not be created: $REASON: disabling cache + Hint: Make sure the directory /homeless-shelter/.cache/dune/db/temp can be created diff --git a/test/blackbox-tests/test-cases/dune-cache/repro-check.t b/test/blackbox-tests/test-cases/dune-cache/repro-check.t index 7be49c92a65..3532343a643 100644 --- a/test/blackbox-tests/test-cases/dune-cache/repro-check.t +++ b/test/blackbox-tests/test-cases/dune-cache/repro-check.t @@ -1,6 +1,7 @@ Test reproducibility check $ export DUNE_CACHE_ROOT=$PWD/.cache + $ export DUNE_CACHE_RULES=enabled $ cat > config < (lang dune 3.0) > (cache enabled) diff --git a/test/blackbox-tests/test-cases/dune-cache/size.t/run.t b/test/blackbox-tests/test-cases/dune-cache/size.t/run.t index a0ec710939b..46e0c8416c0 100644 --- a/test/blackbox-tests/test-cases/dune-cache/size.t/run.t +++ b/test/blackbox-tests/test-cases/dune-cache/size.t/run.t @@ -3,6 +3,7 @@ the cache. $ export DUNE_CACHE=enabled $ export DUNE_CACHE_ROOT=$PWD/.cache + $ export DUNE_CACHE_RULES=enabled $ cat > config << EOF > (lang dune 3.7) diff --git a/test/blackbox-tests/test-cases/dune-cache/symlink.t b/test/blackbox-tests/test-cases/dune-cache/symlink.t index 485b46a31b7..d7fcfcb520b 100644 --- a/test/blackbox-tests/test-cases/dune-cache/symlink.t +++ b/test/blackbox-tests/test-cases/dune-cache/symlink.t @@ -3,6 +3,7 @@ produced symbolic links work correctly and are appropriately cached. $ export DUNE_CACHE=enabled $ export DUNE_CACHE_ROOT=$PWD/.cache + $ export DUNE_CACHE_RULES=enabled $ cat > dune-project < (lang dune 2.1) diff --git a/test/blackbox-tests/test-cases/dune-cache/trim.t b/test/blackbox-tests/test-cases/dune-cache/trim.t index 3e708ad2a75..383aee75ca7 100644 --- a/test/blackbox-tests/test-cases/dune-cache/trim.t +++ b/test/blackbox-tests/test-cases/dune-cache/trim.t @@ -1,4 +1,5 @@ $ export DUNE_CACHE=enabled + $ export DUNE_CACHE_RULES=enabled $ export XDG_RUNTIME_DIR=$PWD/.xdg-runtime $ export XDG_CACHE_HOME=$PWD/.xdg-cache diff --git a/test/blackbox-tests/test-cases/pkg/toolchain-installation.t b/test/blackbox-tests/test-cases/pkg/toolchain-installation.t index 97d7efcafdf..c6f8158dba9 100644 --- a/test/blackbox-tests/test-cases/pkg/toolchain-installation.t +++ b/test/blackbox-tests/test-cases/pkg/toolchain-installation.t @@ -85,9 +85,7 @@ but the fake compiler will end up installed as a toolchain package. Unrecognized line: "Hello from fake ocamlc!" Enumerate the contents of the fake toolchains directory: - $ find fake-cache | sort | remove_hash - fake-cache - fake-cache/dune + $ find fake-cache/dune/toolchains | sort | remove_hash fake-cache/dune/toolchains fake-cache/dune/toolchains/ocaml-base-compiler.1-HASH fake-cache/dune/toolchains/ocaml-base-compiler.1-HASH/target diff --git a/test/expect-tests/dune_config_file/dune_config_test.ml b/test/expect-tests/dune_config_file/dune_config_test.ml index 28948fdb4e7..57ae3ee8d29 100644 --- a/test/expect-tests/dune_config_file/dune_config_test.ml +++ b/test/expect-tests/dune_config_file/dune_config_test.ml @@ -22,9 +22,9 @@ let%expect_test "cache-check-probability 0.1" = ; concurrency = Fixed 1 ; terminal_persistence = Clear_on_rebuild ; sandboxing_preference = [] - ; cache_enabled = Disabled + ; cache_enabled = Enabled ; cache_reproducibility_check = Check_with_probability 0.1 - ; cache_storage_mode = None + ; cache_storage_mode = Some Hardlink ; action_stdout_on_success = Print ; action_stderr_on_success = Print ; experimental = [] @@ -40,7 +40,7 @@ let%expect_test "cache-storage-mode copy" = ; concurrency = Fixed 1 ; terminal_persistence = Clear_on_rebuild ; sandboxing_preference = [] - ; cache_enabled = Disabled + ; cache_enabled = Enabled ; cache_reproducibility_check = Skip ; cache_storage_mode = Some Copy ; action_stdout_on_success = Print @@ -58,7 +58,7 @@ let%expect_test "cache-storage-mode hardlink" = ; concurrency = Fixed 1 ; terminal_persistence = Clear_on_rebuild ; sandboxing_preference = [] - ; cache_enabled = Disabled + ; cache_enabled = Enabled ; cache_reproducibility_check = Skip ; cache_storage_mode = Some Hardlink ; action_stdout_on_success = Print From a27b2f6f95abb7e0e7bc080b06dde2ef19ef7f31 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 26 Aug 2024 19:10:48 +0100 Subject: [PATCH 5/5] _ Signed-off-by: Rudi Grinberg --- bin/common.ml | 19 ++++++++++++++++++- src/dune_rules/main.ml | 26 -------------------------- 2 files changed, 18 insertions(+), 27 deletions(-) diff --git a/bin/common.ml b/bin/common.ml index 9bcc02d61b4..d57b8aaa84d 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -1179,6 +1179,23 @@ let build (builder : Builder.t) = { builder; root; rpc; stats } ;; +let maybe_init_cache (cache_config : Dune_cache.Config.t) = + match cache_config with + | Disabled -> cache_config + | Enabled _ -> + (match Dune_cache_storage.Layout.create_cache_directories () with + | Ok () -> cache_config + | Error (path, exn) -> + User_warning.emit + ~hints: + [ Pp.textf "Make sure the directory %s can be created" (Path.to_string path) ] + [ Pp.textf + "Cache directories could not be created: %s; disabling cache" + (Unix.error_message exn) + ]; + Disabled) +;; + let init (builder : Builder.t) = let c = build builder in if c.root.dir <> Filename.current_dir_name then Sys.chdir c.root.dir; @@ -1232,7 +1249,7 @@ let init (builder : Builder.t) = Dune_rules.Main.init ~stats:c.stats ~sandboxing_preference:config.sandboxing_preference - ~cache_config + ~cache_config:(maybe_init_cache cache_config) ~cache_debug_flags:c.builder.cache_debug_flags (); Only_packages.Clflags.set c.builder.only_packages; diff --git a/src/dune_rules/main.ml b/src/dune_rules/main.ml index 56d2224671b..5d83235ea35 100644 --- a/src/dune_rules/main.ml +++ b/src/dune_rules/main.ml @@ -75,32 +75,6 @@ let init let download ~rule_digest:_ = Fiber.return () end) in - let cache_config = - match cache_config with - | Disabled -> cache_config - | Enabled _ -> - (match Dune_cache_storage.Layout.create_cache_directories () with - | Ok () -> cache_config - | Error (path, exn) -> - (* temporary hack: make sure not to break the line by - disabling the line break *) - let original_margin = Format.get_margin () in - Fun.protect - ~finally:(fun () -> Format.set_margin original_margin) - (fun () -> - Format.set_margin Stdlib.Int.max_int; - User_warning.emit - ~hints: - [ Pp.textf - "Make sure the directory %s can be created" - (Path.to_string path) - ] - [ Pp.textf - "Cache directories could not be created: %s; disabling cache" - (Unix.error_message exn) - ]); - Disabled) - in Build_config.set ~stats ~sandboxing_preference