This is an automated email from the git hooks/post-receive script. zack pushed a commit to branch master in repository cudf.
commit fd8ffb0a30ec9cf963dca52cfa0e5f5eec7ae8e7 Author: Stefano Zacchiroli <z...@upsilon.cc> Date: Tue Apr 29 14:54:56 2014 -0400 Imported Upstream version 0.7 --- BUGS | 6 +-- ChangeLog | 13 +++++++ INSTALL | 1 + Makefile | 18 ++++++--- Makefile.config | 2 +- README | 32 +++++++++++----- TODO | 6 +-- cudf.ml | 105 ++++++++++++++++++++++++++++++++++++++++------------- cudf.mli | 20 ++++++++++ cudf.spec | 2 +- cudf_checker.ml | 2 +- doc/.gitignore | 1 + doc/Makefile | 18 +++++++++ doc/cudf-check.pod | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++ main_cudf_check.ml | 30 +++++++++------ tests.ml | 17 +++++++++ 16 files changed, 311 insertions(+), 61 deletions(-) diff --git a/BUGS b/BUGS index 66e31ae..46c2578 100644 --- a/BUGS +++ b/BUGS @@ -1,3 +1,3 @@ -See issue tracker at -http://gforge.info.ucl.ac.be/tracker/index.php?group_id=35&atid=283 for -component "libcudf". +See issue tracker at: + + https://gforge.inria.fr/tracker/?atid=13811&group_id=4385&func=browse diff --git a/ChangeLog b/ChangeLog index c9de1f2..d01e8a1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2014-04-29 Stefano Zacchiroli <z...@upsilon.cc> + * ALL release 0.7 + * Cudf_checker: do not report as multi-upgrade error a package + providing itself + * Cudf refactoring: change name2pkgs and univ.features internal + structures to list ref from multi-binding hash table. + * Cudf: add iterators on packages grouped by name + * Cudf: allow add/remove imperative changes to universes + (Thanks Pietro Abate for the above 3 patches) + * test runner: port "make test" to ocamlbuild >= 4.x + * cudf-check: make exit code dependent on check result + * cudf-check: include a man page, available under doc/ + 2012-08-03 Stefano Zacchiroli <z...@upsilon.cc> * ALL release 0.6.3 * Cudf: bugfix: ensure that Cudf.status sizes are non-bogus diff --git a/INSTALL b/INSTALL index b45ac06..5acfd78 100644 --- a/INSTALL +++ b/INSTALL @@ -14,6 +14,7 @@ Build dependencies: - glib (only needed to build the C bindings Debian package: "libglib2.0-dev", RPM: "libglib2.0-devel") +- perl (for pod2man, to build cudf-check.1 man page) To build run: diff --git a/Makefile b/Makefile index 82d2ecf..b03c6c8 100644 --- a/Makefile +++ b/Makefile @@ -7,8 +7,9 @@ LIBS_OPT = _build/cudf.cmxa PROGS = _build/main_cudf_check _build/main_cudf_parse_822 PROGS_BYTE = $(addsuffix .byte,$(PROGS)) PROGS_OPT = $(addsuffix .native,$(PROGS)) -RESULTS = $(LIBS) $(PROGS_BYTE) _build/cudf_c.cmo -RESULTS_OPT = $(LIBS_OPT) $(PROGS_OPT) _build/cudf_c.cmx +DOC = doc/cudf-check.1 +RESULTS = $(DOC) $(LIBS) $(PROGS_BYTE) _build/cudf_c.cmo +RESULTS_OPT = $(DOC) $(LIBS_OPT) $(PROGS_OPT) _build/cudf_c.cmx SOURCES = $(wildcard *.ml *.mli *.mll *.mly) C_LIB_DIR = c-lib C_LIB_SOURCES = $(wildcard $(C_LIB_DIR)/*.c $(C_LIB_DIR)/*.h) @@ -33,7 +34,10 @@ opt: $(RESULTS_OPT) $(RESULTS): $(SOURCES) $(RESULTS_OPT): $(SOURCES) -.PHONY: c-lib c-lib-opt +doc/cudf-check.1: doc/cudf-check.pod + $(MAKE) -C doc/ + +.PHONY: c-lib c-lib-opt doc c-lib: make -C $(C_LIB_DIR) all c-lib-opt: @@ -41,6 +45,7 @@ c-lib-opt: clean: make -C $(C_LIB_DIR) clean + make -C doc/ clean $(OCAMLBUILD) $(OBFLAGS) -clean rm -rf $(NAME)-*.gz $(NAME)_*.gz $(NAME)-*/ @@ -55,12 +60,13 @@ top-level: _build/cudf.cma headers: header.txt .headache.conf headache -h header.txt -c .headache.conf $(SOURCES) $(C_LIB_SOURCES) -test: _build/test.byte - $< -verbose +test: test.byte + ./$< -verbose @echo c-lib-test: make -C $(C_LIB_DIR) test -_build/test.byte: $(SOURCES) +test.byte: $(SOURCES) + ocamlbuild $@ tags: TAGS TAGS: $(SOURCES) diff --git a/Makefile.config b/Makefile.config index 2f29c80..7c4b9ed 100644 --- a/Makefile.config +++ b/Makefile.config @@ -1,4 +1,4 @@ -VERSION = 0.6.3 +VERSION = 0.7 export DESTDIR = diff --git a/README b/README index ca61082..ba811e5 100644 --- a/README +++ b/README @@ -27,25 +27,39 @@ as found by a package manager. libCUDF enables manipulation of CUDF and related documents. -Bugs ----- +Development +----------- -Please report bugs to the gforge bug tracker available at: +Development happens on the INRIA Forge, in the [cudf project][1]. There you can +find: - http://gforge.info.ucl.ac.be/tracker/?group_id=35 +* [releases][4] +* [Git repository][5] +* [bug reports][6] -when reporting bug, please select the "libcudf" component. +[1]: https://gforge.inria.fr/projects/cudf/ +[4]: https://gforge.inria.fr/frs/?group_id=4385 +[5]: https://gforge.inria.fr/scm/?group_id=4385 +[6]: https://gforge.inria.fr/tracker/?group_id=4385 + +Please report bugs using the forge [bug tracker][6] rather than mailing me +directly. + +If you're in a hurry and just want to get the latest version of the code, here +is the command you're looking for: + + $ git clone https://gforge.inria.fr/git/cudf/cudf.git Reference --------- libCUDF implements the Common Upgradeability Description Format (CUDF) -2.0 specifications [1], edited by the Mancoosi project [2]. +2.0 [specifications][2], edited by the [Mancoosi project][3]. -[1] http://www.mancoosi.org/reports/tr3.pdf -[2] http://www.mancoosi.org +[2]: http://www.mancoosi.org/reports/tr3.pdf +[3]: http://www.mancoosi.org - -- Stefano Zacchiroli <z...@pps.jussieu.fr> Thu, 26 Nov 2009 10:49:32 +0100 + -- Stefano Zacchiroli <z...@upsilon.cc> Sun, 14 Oct 2012 16:28:32 +0100 diff --git a/TODO b/TODO index 66e31ae..46c2578 100644 --- a/TODO +++ b/TODO @@ -1,3 +1,3 @@ -See issue tracker at -http://gforge.info.ucl.ac.be/tracker/index.php?group_id=35&atid=283 for -component "libcudf". +See issue tracker at: + + https://gforge.inria.fr/tracker/?atid=13811&group_id=4385&func=browse diff --git a/cudf.ml b/cudf.ml index f971706..3ab7cdd 100644 --- a/cudf.ml +++ b/cudf.ml @@ -37,6 +37,7 @@ type request = { upgrade : vpkglist ; req_extra : typed_value stanza ; } + type preamble = { preamble_id : string ; property : typedecl ; @@ -44,16 +45,17 @@ type preamble = { status_checksum: string ; req_checksum: string ; } + type cudf_doc = preamble option * package list * request type cudf_item = [ `Preamble of preamble | `Package of package | `Request of request ] type universe = { id2pkg: ((string * int), package) Hashtbl.t; (** <name, ver> -> pkg *) - name2pkgs: (string, package) Hashtbl.t; (** name -> pkg (multi-bindings) *) + name2pkgs: (string, package list ref) Hashtbl.t; (** name -> pkg list ref *) uid2pkgs: (int, package) Hashtbl.t; (** int uid -> pkg *) id2uid: ((pkgname * version), int) Hashtbl.t; (** <name, ver> -> int uid *) - features: (string, (package * version option)) Hashtbl.t; - (** feature -> avail feature versions (multi-bindings) + features: (string, (package * version option) list ref) Hashtbl.t; + (** feature -> avail feature versions Each available feature is reported as a pair <owner, provided version>, where owner is the package providing it. Provided version "None" means "all possible @@ -113,34 +115,81 @@ let empty_universe () = univ_size = 0 ; inst_size = 0 ; } +let add_to_hash_list h n p = + try let l = Hashtbl.find h n in l := p :: !l + with Not_found -> Hashtbl.add h n (ref [p]) + +let get_hash_list h n = try !(Hashtbl.find h n) with Not_found -> [] + (** process all features (i.e., Provides) provided by a given package and fill with them a given feature table *) let expand_features pkg features = List.iter (function - | name, None -> Hashtbl.add features name (pkg, None) - | name, Some (_, ver) -> Hashtbl.add features name (pkg, (Some ver))) + | name, None -> add_to_hash_list features name (pkg, None) + | name, Some (_, ver) -> add_to_hash_list features name (pkg, (Some ver))) pkg.provides +let add_package_aux univ pkg uid = + let id = pkg.package, pkg.version in + if Hashtbl.mem univ.id2pkg id then + raise (Constraint_violation (sprintf "duplicate package: <%s, %d>" pkg.package pkg.version)) + else begin + Hashtbl.add univ.uid2pkgs uid pkg; + Hashtbl.add univ.id2uid id uid; + Hashtbl.add univ.id2pkg id pkg; + add_to_hash_list univ.name2pkgs pkg.package pkg; + expand_features pkg univ.features; + univ.univ_size <- univ.univ_size + 1; + if pkg.installed then + univ.inst_size <- univ.inst_size + 1 + end + +let add_package univ pkg = + let uid = (Hashtbl.length univ.uid2pkgs) + 1 in + add_package_aux univ pkg uid + +let remove_package univ id = + if not (Hashtbl.mem univ.id2pkg id) then () + else begin + let uid = Hashtbl.find univ.id2uid id in + let p = Hashtbl.find univ.uid2pkgs uid in + + let l = Hashtbl.find univ.name2pkgs p.package in + l := List.remove !l p; + if List.length !l = 0 then + Hashtbl.remove univ.name2pkgs p.package; + + List.iter + (function + | name, None -> + let l = Hashtbl.find univ.features name in + l := List.remove !l (p, None); + if List.length !l = 0 then + Hashtbl.remove univ.features name + | name, Some (_, ver) -> + let l = Hashtbl.find univ.features name in + l := List.remove !l (p, (Some ver)); + if List.length !l = 0 then + Hashtbl.remove univ.features name) + p.provides; + + Hashtbl.remove univ.uid2pkgs uid; + Hashtbl.remove univ.id2uid id; + Hashtbl.remove univ.id2pkg id; + + univ.univ_size <- univ.univ_size - 1; + if p.installed then + univ.inst_size <- univ.inst_size - 1; + end + let load_universe pkgs = let univ = empty_universe () in let uid = ref 0 in List.iter (fun pkg -> - let id = pkg.package, pkg.version in - Hashtbl.add univ.uid2pkgs !uid pkg; - Hashtbl.add univ.id2uid id !uid; - incr uid; - if Hashtbl.mem univ.id2pkg id then - raise (Constraint_violation - (sprintf "duplicate package: <%s, %d>" - pkg.package pkg.version)); - Hashtbl.add univ.id2pkg id pkg; - Hashtbl.add univ.name2pkgs pkg.package pkg; - expand_features pkg univ.features; - univ.univ_size <- univ.univ_size + 1; - if pkg.installed then - univ.inst_size <- univ.inst_size + 1) + add_package_aux univ pkg !uid; + incr uid) pkgs; univ @@ -157,6 +206,14 @@ let iteri_packages f univ = Hashtbl.iter (fun _id pkg -> f _id pkg) univ.uid2pkg let fold_packages f init univ = Hashtbl.fold (fun _id pkg acc -> f acc pkg) univ.id2pkg init +let iter_packages_by_name f univ = + Hashtbl.iter (fun n { contents = l } -> f n l) univ.name2pkgs + +let fold_packages_by_name f a univ = + Hashtbl.fold (fun n { contents = l } a -> f a n l) univ.name2pkgs a + +let package_names univ = List.of_enum (Hashtbl.keys univ.name2pkgs) + let get_packages ?filter univ = match filter with | None -> fold_packages (fun acc pkg -> pkg :: acc) [] univ @@ -182,7 +239,7 @@ let status univ = (fun id pkg -> match pkg with | { installed = true } -> Hashtbl.add univ'.id2pkg id pkg; - Hashtbl.add univ'.name2pkgs pkg.package pkg; + add_to_hash_list univ'.name2pkgs pkg.package pkg; expand_features pkg univ'.features | _ -> ()) univ.id2pkg; @@ -191,7 +248,7 @@ let status univ = univ' let lookup_packages ?(filter=None) univ pkgname = - let packages = Hashtbl.find_all univ.name2pkgs pkgname in + let packages = get_hash_list univ.name2pkgs pkgname in match filter with None -> packages | Some _ as pred -> List.filter (fun p -> p.version |= pred) packages @@ -203,7 +260,7 @@ let mem_installed ?(include_features = true) ?(ignore = fun _ -> false) univ (name, constr) = let pkg_filter = fun pkg -> not (ignore pkg) in let mem_feature constr = - let feats = Hashtbl.find_all univ.features name in + let feats = get_hash_list univ.features name in List.exists (function | owner_pkg, _ when not owner_pkg.installed -> false @@ -221,8 +278,7 @@ let who_provides ?(installed=true) univ (pkgname, constr) = |_, None -> true | _, Some v -> v |= constr ) - (Hashtbl.find_all univ.features pkgname) - + (get_hash_list univ.features pkgname) let lookup_typed_package_property pkg = function | "package" -> `Pkgname pkg.package @@ -259,6 +315,5 @@ let lookup_request_property req prop = let lookup_preamble_property pre prop = string_of_value (lookup_typed_preamble_property pre prop) - let lookup_package_typedecl ?(extra = []) prop = List.assoc prop (Cudf_conf.package_typedecl @ extra) diff --git a/cudf.mli b/cudf.mli index a3d2718..9bddf66 100644 --- a/cudf.mli +++ b/cudf.mli @@ -102,6 +102,15 @@ type solution = preamble * universe the given package list *) val load_universe : package list -> universe +(** add a package to an existing universe. The universe is modified in place. + @raise Constraint_violation if a package with the same name and version is + alreayd in the given universe *) +val add_package : universe -> package -> unit + +(** remove a package from an existing universe. + The universe is modified in place *) +val remove_package : universe -> pkgname * version -> unit + (** {5 CUDF manipulation} *) (** Lookup a specific package via a <name, version> key @@ -166,6 +175,17 @@ val fold_packages : ('a -> package -> 'a) -> 'a -> universe -> 'a both the package and its unique identifier *) val iteri_packages : (int -> package -> unit) -> universe -> unit +(** iter on all packages grouped by name. Each package name is associated to + a list of packages with the same name and different versions *) +val iter_packages_by_name : (pkgname -> package list -> unit) -> universe -> unit + +(** fold on all packages grouped by name. Each package name is associated to + a list of packages with the same name and different versions *) +val fold_packages_by_name : ('a -> pkgname -> package list -> 'a) -> 'a -> universe -> 'a + +(** return the list of all unique package names *) +val package_names : universe -> pkgname list + (** conversion from universe to plain package list @param filter only return packages matching a given diff --git a/cudf.spec b/cudf.spec index 4409263..b4c96ed 100644 --- a/cudf.spec +++ b/cudf.spec @@ -2,7 +2,7 @@ Summary: CUDF (Common Upgradeability Description Format) tools and libraries Name: cudf Version: 0.6 Release: 1 -Source: http://gforge.info.ucl.ac.be/frs/?group_id=35 +Source: https://gforge.inria.fr/frs/?group_id=4385 URL: http://www.mancoosi.org/cudf/ License: LGPL Group: Development/Libraries diff --git a/cudf_checker.ml b/cudf_checker.ml index 812da09..3724b86 100644 --- a/cudf_checker.ml +++ b/cudf_checker.ml @@ -138,7 +138,7 @@ let is_solution (univ, req) sol = let res = List.fold_left (fun (ok, downgrades, multi) ((name, _constr) as vpkg) -> - match versions_of sol name with + match List.unique (versions_of sol name) with | [Some v] -> let old_installed = versions_of univ name in if not (List.for_all diff --git a/doc/.gitignore b/doc/.gitignore new file mode 100644 index 0000000..3b1daeb --- /dev/null +++ b/doc/.gitignore @@ -0,0 +1 @@ +cudf-check.1 diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 index 0000000..390b384 --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,18 @@ +include ../Makefile.config + +MANPAGES = cudf-check + +GEN_STUFF = $(patsubst %,%.1,$(MANPAGES)) + +all: $(GEN_STUFF) + +%.1: %.pod + pod2man --release $(VERSION) $< > $@ + +clean: + rm -f $(GEN_STUFF) + +show: cudf-check.1 + man -l $< + +.PHONY: all clean show diff --git a/doc/cudf-check.pod b/doc/cudf-check.pod new file mode 100644 index 0000000..f361a2a --- /dev/null +++ b/doc/cudf-check.pod @@ -0,0 +1,99 @@ +=head1 NAME + +cudf-check - manipulate CUDF documents + + +=head1 SYNOPSIS + +=over + +=item B<cudf-check> [I<OPTION>] + +=back + + +=head1 DESCRIPTION + +cudf-check is a command line tool to manipulate and validate CUDF documents. + +=head2 Use Cases + +=over + +=item validate a CUDF document (package universe + request): + +=over + +B<cudf-check -cudf> I<FILE> + +=back + +=item validate a CUDF document (package universe + request) and its solution + +=over + +B<cudf-check -cudf> I<FILE> B<-sol> I<FILE> + +=back + +=item validate a package universe (without user request) + +=over + +B<cudf-check -univ> I<FILE> + +=back + +=back + + +=head1 OPTIONS + +=over 4 + +=item -cudf + +parse the given CUDF (universe + request) + +=item -univ + +parse the given package universe + +=item -sol + +parse the given solution + +=item -dump + +dump results to standard output + +=item -help + +=item --help + +show usage information and exit + +=back + + +=head1 EXIT STATUS + +cudf-check returns an exit status of 0 (true) if all performed checks (universe +consistency, solution consistency, request-solution correspondence) were +successful; if one or more of them fails, cudf-check returns an exit status of +1 (false). + + +=head1 SEE ALSO + +apt-cudf(1), update-cudf-solvers(8) + + +=head1 AUTHOR + +Copyright: (C) 2009-2014 Stefano Zacchiroli <z...@upsilon.cc> + +License: GNU General Public License (GPL), version 3 or above + + +=cut diff --git a/main_cudf_check.ml b/main_cudf_check.ml index 99caa50..0f3c5f9 100644 --- a/main_cudf_check.ml +++ b/main_cudf_check.ml @@ -41,14 +41,15 @@ In particular: cudf-check -univ FILE validate package universe (no request) Options:" -let die_usage () = Arg.usage arg_spec usage_msg ; exit (-2) +let die_usage () = Arg.usage arg_spec usage_msg ; exit 2 let print_inst_info inst = match is_consistent inst with - | true, _ -> printf "original installation status consistent\n%!" + | true, _ -> printf "original installation status consistent\n%!"; true | false, Some r -> printf "original installation status inconsistent (reason: %s)\n%!" - (explain_reason (r :> bad_solution_reason)) + (explain_reason (r :> bad_solution_reason)); + false | _ -> assert false let print_cudf (pre, univ, req) = @@ -63,10 +64,11 @@ let print_univ univ = let print_sol_info inst sol = match is_solution inst sol with - | true, _ -> printf "is_solution: true\n%!" + | true, _ -> printf "is_solution: true\n%!"; true | false, rs -> printf "is_solution: false (reason: %s)\n%!" - (String.concat "; " (List.map explain_reason rs)) + (String.concat "; " (List.map explain_reason rs)); + false let pp_loc (start_pos, end_pos) = let line { Lexing.pos_lnum = l } = l in @@ -84,6 +86,7 @@ let main () = eprintf "Location: %s\n%!" (pp_loc loc) ; exit 1 in + let exit_ rc = if rc then exit 0 else exit 1 in if !cudf_arg <> "" then begin try let p = Cudf_parser.from_in_channel (open_in !cudf_arg) in @@ -117,15 +120,17 @@ let main () = sol := Some (Cudf_parser.from_in_channel (open_in !sol_arg)); match !cudf, !univ, !sol with | Some (pre,univ,req), None, None -> - print_inst_info univ; - print_cudf (pre,univ,req) + let rc = print_inst_info univ in + print_cudf (pre,univ,req); + exit_ rc | Some (pre,univ,req), None, Some sol_parser -> (try eprintf "loading solution ...\n%!"; let _pre', sol = Cudf_parser.load_solution sol_parser univ in - print_inst_info univ; - print_sol_info (univ,req) sol; - print_cudf (pre,univ,req) + let rc1 = print_inst_info univ in + let rc2 = print_sol_info (univ,req) sol in + print_cudf (pre,univ,req); + exit_ (rc1 && rc2) with | Cudf_parser.Parse_error (msg, loc) -> fail_parse "solution" msg loc | Cudf.Constraint_violation _ as exn -> @@ -133,8 +138,9 @@ let main () = !sol_arg (Printexc.to_string exn); exit (-1)) | None, Some univ, None -> - print_inst_info univ; - print_univ univ + let rc = print_inst_info univ in + print_univ univ; + exit_ rc | _ -> die_usage () let _ = diff --git a/tests.ml b/tests.ml index c181892..5d2457c 100644 --- a/tests.ml +++ b/tests.ml @@ -555,6 +555,22 @@ let univ_sizes = (installed_size (Lazy.force univ)) 6); ] +let univ_manipulation = + let univ = (let _, univ, _ = load_cudf_test "legacy" in univ) in + let car = lookup_package univ ("car", 1) in + "universe manipulations" >::: [ + "remove package" >:: + (fun () -> + remove_package univ ("car", 1); + assert_equal false (Cudf.mem_package univ ("car", 1)) + ); + "add package" >:: + (fun () -> + add_package univ car; + assert_equal car (lookup_package univ ("car", 1)) + ); + ] + let default_value = let univ = lazy (let _, univ, _ = load_cudf_test "legacy" in univ) in "default value of opt prop" >::: [ @@ -620,6 +636,7 @@ let feature_suite = self_conflicts ; consistency ; univ_sizes ; + univ_manipulation ; default_value ; typedecl_lookup ; ] -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/cudf.git _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits