From 8cb5442ac251c9e11d3f19f42c1f5e50ccd874ef Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Thu, 10 Oct 2024 15:24:34 +0200 Subject: [PATCH 1/4] reftest: more precise type names and specification --- tests/reftests/run.ml | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/reftests/run.ml b/tests/reftests/run.ml index f81b2420579..74bde0caf91 100644 --- a/tests/reftests/run.ml +++ b/tests/reftests/run.ml @@ -260,6 +260,8 @@ let rec with_temp_dir f = (mkdir_p s; finally f s @@ fun () -> rm_rf s) +type filter = (Re.t * filt_sort) list + type command = | File_contents of string | Repo_pkg_file_contents of @@ -267,14 +269,14 @@ type command = * [ `opam | `files of string (* file name *) ] | Pin_file_content of string - | Cat of { files: string list; - filter: (Re.t * filt_sort) list; } + | Opamfile of { files: string list; + filter: filter; } | Json of { files: string list; - filter: (Re.t * filt_sort) list; } + filter: filter; } | Run of { env: (string * string) list; cmd: string; args: string list; (* still escaped *) - filter: (Re.t * filt_sort) list; + filter: filter; output: string option; unordered: bool; sort: bool;} @@ -475,7 +477,7 @@ module Parse = struct let args, unordered, sort, rewr, output = get_args_rewr [] args in match cmd with | Some "opam-cat" -> - Cat { files = args; filter = rewr; } + Opamfile { files = args; filter = rewr; } | Some "json-cat" -> Json { files = args; filter = rewr; } | Some cmd -> @@ -886,7 +888,7 @@ let run_test ?(vars=[]) ~opam t = in (v, value) :: List.filter (fun (w, _) -> not (String.equal v w)) vars) vars bindings - | Cat { files; filter } -> + | Opamfile { files; filter } -> let files = List.map (fun s -> Re.(replace_string (compile @@ str "$OPAMROOT") ~by:opamroot s)) files From 6f144afe72da0cb178ac9f6863ff0c8f967bc0c9 Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Thu, 10 Oct 2024 15:25:56 +0200 Subject: [PATCH 2/4] reftest: generalise file printer --- master_changes.md | 1 + tests/reftests/run.ml | 42 ++++++++++++++++++++++++++++++------------ 2 files changed, 31 insertions(+), 12 deletions(-) diff --git a/master_changes.md b/master_changes.md index 1b0af8c6bb0..00d623238dd 100644 --- a/master_changes.md +++ b/master_changes.md @@ -116,6 +116,7 @@ users) * pin: add a test for erroneous first fetch done as local path on local VCS pinned packages [#6221 @rjbou] ### Engine + * Update print file function [#6233 @rjbou] ## Github Actions * Add OCaml 5.2.0 to the build matrix [#6216 @kit-ty-kate] diff --git a/tests/reftests/run.ml b/tests/reftests/run.ml index 74bde0caf91..7dd31d1465b 100644 --- a/tests/reftests/run.ml +++ b/tests/reftests/run.ml @@ -639,14 +639,18 @@ dev-repo: "hg+https://pkg@op.am" bug-reports: "https://nobug" |} "" -let print_file ~filters reader names = +let print_file ~filters ?(single_header=true) names_and_content = let files = - match names with - | [file] -> [reader file] - | files -> + let with_name () = List.map - (fun f -> Printf.sprintf "=> %s <=\n%s" f (reader f)) - files + (fun (name, content) -> + Printf.sprintf "=> %s <=\n%s" name content) + names_and_content + in + if single_header then with_name () else + match names_and_content with + | [name, content] -> [content] + | _ -> with_name () in List.map (fun s -> OpamStd.String.split s '\n') files |> List.flatten @@ -890,11 +894,16 @@ let run_test ?(vars=[]) ~opam t = vars bindings | Opamfile { files; filter } -> let files = - List.map (fun s -> Re.(replace_string (compile @@ str "$OPAMROOT") - ~by:opamroot s)) files + List.map (fun s -> + let name = + Re.(replace_string (compile @@ str "$OPAMROOT") + ~by:opamroot s) + in + name, print_opamfile name) + files in - print_file ~filters:(filter @ common_filters dir) - print_opamfile files; + let filters = filter @ common_filters dir in + print_file ~single_header:false ~filters files; vars | Json { files; filter } -> let files = @@ -941,8 +950,17 @@ let run_test ?(vars=[]) ~opam t = OpamJson.to_string ~minify:false json ^ "\n" | None -> "# Return Error reading json\n"^content in - print_file ~filters:(filter @ common_filters ~opam dir @ json_filters) - to_string files; + let files = + List.map (fun s -> + let name = + Re.(replace_string (compile @@ str "$OPAMROOT") + ~by:opamroot s) + in + name, to_string name) + files + in + let filters = filter @ common_filters ~opam dir @ json_filters in + print_file ~single_header:false ~filters files; vars | Run {env; cmd; args; filter; output; unordered; sort} -> let silent = output <> None || unordered in From 48c56c2e711c361184c380cc9e5f4a43607c844b Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Thu, 10 Oct 2024 16:28:40 +0200 Subject: [PATCH 3/4] state: export loading cache function --- master_changes.md | 1 + src/state/opamSwitchState.mli | 1 + 2 files changed, 2 insertions(+) diff --git a/master_changes.md b/master_changes.md index 00d623238dd..1070342941d 100644 --- a/master_changes.md +++ b/master_changes.md @@ -135,6 +135,7 @@ users) ## opam-repository ## opam-state + * `OpamSwitchState.Installed_cache`: export `load` function [#6233 @rjbou] ## opam-solver diff --git a/src/state/opamSwitchState.mli b/src/state/opamSwitchState.mli index 9ed1c2e3e1a..f0e4096c048 100644 --- a/src/state/opamSwitchState.mli +++ b/src/state/opamSwitchState.mli @@ -297,6 +297,7 @@ val avoid_version : 'a switch_state -> package -> bool (** Handle a cache of the opam files of installed packages *) module Installed_cache: sig type t = OpamFile.OPAM.t OpamPackage.Map.t + val load: OpamFilename.t -> t option val save: OpamFilename.t -> t -> unit val remove: OpamFilename.t -> unit end From 859aa8d6167d0ce82e4c46b4a3e0486914241fb3 Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Thu, 10 Oct 2024 16:10:50 +0200 Subject: [PATCH 4/4] reftest: add opam-cache command that displays internal opam caches content --- master_changes.md | 1 + tests/reftests/dune | 2 +- tests/reftests/readme.md | 5 ++ tests/reftests/reftests.test | 146 +++++++++++++++++++++++++++++++++++ tests/reftests/run.ml | 107 ++++++++++++++++++++++++- 5 files changed, 259 insertions(+), 2 deletions(-) diff --git a/master_changes.md b/master_changes.md index 1070342941d..6acf10b8005 100644 --- a/master_changes.md +++ b/master_changes.md @@ -117,6 +117,7 @@ users) ### Engine * Update print file function [#6233 @rjbou] + * Add `opam-cache` command, to display internal cache content in reftest [#6233 @rjbou] ## Github Actions * Add OCaml 5.2.0 to the build matrix [#6216 @kit-ty-kate] diff --git a/tests/reftests/dune b/tests/reftests/dune index 41e64de91e8..e681669a499 100644 --- a/tests/reftests/dune +++ b/tests/reftests/dune @@ -6,7 +6,7 @@ (executable (name run) - (libraries opam-core re opam-file-format) + (libraries opam-core re opam-file-format opam-state) (modules run)) (executable diff --git a/tests/reftests/readme.md b/tests/reftests/readme.md index 17984545a79..eb4e5aad320 100644 --- a/tests/reftests/readme.md +++ b/tests/reftests/readme.md @@ -70,6 +70,11 @@ output... * `json-cat file`: print a human readable opam output json file, with replacement of some duration and temporary files names. meant to be used on opam generated json files. + * `opam-cache installed [nvs]`: print the content of installed + packages cache for switch ``. If `[nvs]` is specified, filter over + these package names or packages. + * `opam-cache repo [nvs]`: print the content of repository cache. If + `[nvs]` is specified, filter over these package names or packages. - if you need more shell power, create a script using then run it. Or just use `sh -c`... but beware for compatibility. diff --git a/tests/reftests/reftests.test b/tests/reftests/reftests.test index 56047464057..00f225a12da 100644 --- a/tests/reftests/reftests.test +++ b/tests/reftests/reftests.test @@ -363,3 +363,149 @@ Done. } ] } +### :V:3: Cache cat +### +opam-version: "2.0" +### +opam-version: "2.0" +### +opam-version: "2.0" +### +opam-version: "2.0" +### opam switch create cache --empty +### opam repository add oper ./OPER +[oper] Initialised +[NOTE] Repository oper has been added to the selections of switch cache only. + Run `opam repository add oper --all-switches|--set-default' to use it in all existing switches, or in newly created switches, respectively. + +### opam install bar baz foo un deux +The following actions will be performed: +=== install 5 packages + - install bar 1 + - install baz 1 + - install deux 2 + - install foo 2 + - install un 2 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +-> installed bar.1 +-> installed baz.1 +-> installed deux.2 +-> installed foo.2 +-> installed un.2 +Done. +### :V:3: installed packages cache +### opam-cache installed cache +=> un.2 <= +opam-version: "2.0" +name: "un" +version: "2" +=> foo.2 <= +opam-version: "2.0" +name: "foo" +version: "2" +=> deux.2 <= +opam-version: "2.0" +name: "deux" +version: "2" +=> baz.1 <= +opam-version: "2.0" +name: "baz" +version: "1" +extra-files: ["xf-baz" "md5=9ac116bceba2bdf45065df19d26a6b64"] +=> bar.1 <= +opam-version: "2.0" +name: "bar" +version: "1" +extra-files: ["xf-bar" "md5=dbaf1ea561686374373dc7d154f3a0ff"] +### opam-cache installed cache foo +=> foo.2 <= +opam-version: "2.0" +name: "foo" +version: "2" +### opam-cache installed cache foo un +=> un.2 <= +opam-version: "2.0" +name: "un" +version: "2" +=> foo.2 <= +opam-version: "2.0" +name: "foo" +version: "2" +### opam-cache installed cache inexistent +### opam switch create cache2 --empty +### opam-cache installed cache2 +Empty cache +### opam-cache installed cache2 foo +Empty cache +### opam-cache installed cache3 +No cache +### :V:3:b: repo cache +### opam-cache repo +=> oper:un.2 <= +opam-version: "2.0" +name: "un" +version: "2" +=> oper:foo.2 <= +opam-version: "2.0" +name: "foo" +version: "2" +=> oper:deux.2 <= +opam-version: "2.0" +name: "deux" +version: "2" +=> default:qux.1 <= +opam-version: "2.0" +name: "qux" +version: "1" +extra-files: ["xf-qux" "md5=ccacf3e9d1e3f473e093042aa309e9da"] +=> default:grault.1 <= +opam-version: "2.0" +name: "grault" +version: "1" +extra-files: [ + ["file" "md5=00000000000000000000000000000000"] + ["xf-grault" "md5=9fd8d4d58e5fd899478b03ab24a11d00"] + ["xf-grault2" "md5=5c1ff559ac6490338d362978c058f44a"] +] +=> default:foo.1 <= +opam-version: "2.0" +name: "foo" +version: "1" +extra-files: ["xfile" "md5=f343d90d29f2632b7e5fcf8ee249d1b5"] +=> default:corge.1 <= +opam-version: "2.0" +name: "corge" +version: "1" +extra-files: ["xf-corge" "md5=71e14bfb95ec10cb60f3b6cafd908a08"] +=> default:baz.1 <= +opam-version: "2.0" +name: "baz" +version: "1" +extra-files: ["xf-baz" "md5=9ac116bceba2bdf45065df19d26a6b64"] +=> default:bar.1 <= +opam-version: "2.0" +name: "bar" +version: "1" +extra-files: ["xf-bar" "md5=dbaf1ea561686374373dc7d154f3a0ff"] +### opam-cache repo foo +=> oper:foo.2 <= +opam-version: "2.0" +name: "foo" +version: "2" +=> default:foo.1 <= +opam-version: "2.0" +name: "foo" +version: "1" +extra-files: ["xfile" "md5=f343d90d29f2632b7e5fcf8ee249d1b5"] +### opam-cache repo un baz +=> oper:un.2 <= +opam-version: "2.0" +name: "un" +version: "2" +=> default:baz.1 <= +opam-version: "2.0" +name: "baz" +version: "1" +extra-files: ["xf-baz" "md5=9ac116bceba2bdf45065df19d26a6b64"] +### opam-cache repo inexistent diff --git a/tests/reftests/run.ml b/tests/reftests/run.ml index 7dd31d1465b..9875ac94a43 100644 --- a/tests/reftests/run.ml +++ b/tests/reftests/run.ml @@ -273,6 +273,10 @@ type command = filter: filter; } | Json of { files: string list; filter: filter; } + | Cache of { kind: [`installed | `repo]; + switch: string; + nvs: string list; + filter: filter; } | Run of { env: (string * string) list; cmd: string; args: string list; (* still escaped *) @@ -480,6 +484,21 @@ module Parse = struct Opamfile { files = args; filter = rewr; } | Some "json-cat" -> Json { files = args; filter = rewr; } + | Some "opam-cache" -> + let kind, switch, nvs = + match args with + | "installed"::switch::nvs -> + `installed, switch, nvs + | "repo"::nvs -> + `repo, "", nvs + | _ -> + failwith + (Printf.sprintf + "Bad usage of opam-cache %s.\n\ + expecting 'opam-cache [nvs]" + (String.concat " " args)) + in + Cache { kind; switch; nvs; filter = rewr; } | Some cmd -> let env, plus = List.fold_left (fun (env,plus) (v,op,value) -> @@ -649,7 +668,7 @@ let print_file ~filters ?(single_header=true) names_and_content = in if single_header then with_name () else match names_and_content with - | [name, content] -> [content] + | [_, content] -> [content] | _ -> with_name () in List.map (fun s -> OpamStd.String.split s '\n') files @@ -962,6 +981,92 @@ let run_test ?(vars=[]) ~opam t = let filters = filter @ common_filters ~opam dir @ json_filters in print_file ~single_header:false ~filters files; vars + | Cache { switch; kind; nvs; filter } -> + let nvs = + List.fold_left (fun nvs s -> + match OpamPackage.of_string_opt s with + | Some nv -> + let n = OpamPackage.name nv in + let v = OpamPackage.version nv in + OpamPackage.Name.Map.update n + (OpamPackage.Version.Set.add v) + (OpamPackage.Version.Set.singleton v) + nvs + | None -> + OpamPackage.Name.Map.add + (OpamPackage.Name.of_string s) + OpamPackage.Version.Set.empty + nvs) + OpamPackage.Name.Map.empty nvs + in + (match kind with + | `installed -> + (let cache = + OpamSwitchState.Installed_cache.load + (OpamPath.Switch.installed_opams_cache + (OpamFilename.Dir.of_string opamroot) + (OpamSwitch.of_string switch)) + in + match cache with + | None -> print_string "No cache\n" + | Some cache when OpamPackage.Map.is_empty cache -> + print_string "Empty cache\n" + | Some cache -> + let cache = + if OpamPackage.Name.Map.is_empty nvs then cache else + OpamPackage.Map.filter (fun nv _ -> + let n = OpamPackage.name nv in + match OpamPackage.Name.Map.find_opt n nvs with + | Some vs -> + OpamPackage.Version.Set.is_empty vs + || OpamPackage.Version.Set.mem + (OpamPackage.version nv) vs + | None -> false) + cache + in + let files = + OpamPackage.Map.fold (fun pkg opam files -> + let name = OpamPackage.to_string pkg in + let content = OpamFile.OPAM.write_to_string opam in + (name, content)::files) + cache [] + in + print_file ~filters:(filter @ common_filters dir) files) + | `repo -> + (let cache = + OpamRepositoryState.Cache.load + (OpamFilename.Dir.of_string opamroot) + in + match cache with + | None -> print_string "No cache\n" + | Some (_, cache) when OpamRepositoryName.Map.is_empty cache -> + print_string "Empty cache\n" + | Some (_, cache) -> + let cache = + if OpamPackage.Name.Map.is_empty nvs then cache else + OpamRepositoryName.Map.map + (OpamPackage.Map.filter (fun nv _ -> + let n = OpamPackage.name nv in + match OpamPackage.Name.Map.find_opt n nvs with + | Some vs -> + OpamPackage.Version.Set.is_empty vs + || OpamPackage.Version.Set.mem + (OpamPackage.version nv) vs + | None -> false)) + cache + in + let files = + OpamRepositoryName.Map.fold (fun reponame pkgmap files-> + let pre = OpamRepositoryName.to_string reponame in + OpamPackage.Map.fold (fun pkg opam files -> + let name = pre ^ ":" ^ OpamPackage.to_string pkg in + let content = OpamFile.OPAM.write_to_string opam in + (name, content)::files) + pkgmap files) + cache [] + in + print_file ~filters:(filter @ common_filters dir) files)); + vars | Run {env; cmd; args; filter; output; unordered; sort} -> let silent = output <> None || unordered in let r, errcode =