[Pkg-ocaml-maint-commits] r5962 - in /trunk/packages/edos-debcheck/trunk/debian/edos-future: Makefile upclose.ml

[treinen at users.alioth.debian.org]

Author: treinen
Date: Thu Aug 21 15:52:43 2008
New Revision: 5962

URL: http://svn.debian.org/wsvn/pkg-ocaml-maint/?sc=1&rev=5962
Log:
started to work on upward closure

Added:
    trunk/packages/edos-debcheck/trunk/debian/edos-future/Makefile
    trunk/packages/edos-debcheck/trunk/debian/edos-future/upclose.ml

Added: trunk/packages/edos-debcheck/trunk/debian/edos-future/Makefile
URL: http://svn.debian.org/wsvn/pkg-ocaml-maint/trunk/packages/edos-debcheck/trunk/debian/edos-future/Makefile?rev=5962&op=file
==============================================================================
--- trunk/packages/edos-debcheck/trunk/debian/edos-future/Makefile (added)
+++ trunk/packages/edos-debcheck/trunk/debian/edos-future/Makefile Thu Aug 21 15:52:43 2008
@@ -1,0 +1,16 @@
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+FLAVOUR=native
+MAIN=upclose
+
+$(MAIN): $(MAIN).$(FLAVOUR)
+	ln -sf $(MAIN).$(FLAVOUR) $(MAIN)
+
+$(MAIN).byte: $(MAIN).ml
+	$(OCAMLC) -I +dose2 -o $(MAIN).byte nums.cma unix.cma zip/zip.cma str.cma dose2/util.cma ocamldeb.cma dose2/io.cma napkin.cma upclose.ml
+
+$(MAIN).native: $(MAIN).ml
+	$(OCAMLOPT) -I +dose2 -I +zip -o $(MAIN).native nums.cmxa unix.cmxa zip/zip.cmxa str.cmxa dose2/util.cmxa ocamldeb.cmxa dose2/io.cmxa napkin.cmxa upclose.ml
+
+clean:
+	-rm -f *.{cmo,cmi,cmx,o} $(MAIN).{byte,native} $(MAIN)

Added: trunk/packages/edos-debcheck/trunk/debian/edos-future/upclose.ml
URL: http://svn.debian.org/wsvn/pkg-ocaml-maint/trunk/packages/edos-debcheck/trunk/debian/edos-future/upclose.ml?rev=5962&op=file
==============================================================================
--- trunk/packages/edos-debcheck/trunk/debian/edos-future/upclose.ml (added)
+++ trunk/packages/edos-debcheck/trunk/debian/edos-future/upclose.ml Thu Aug 21 15:52:43 2008
@@ -1,0 +1,69 @@
+open Napkin;;
+open Ocamldeb;;
+open Arg;;
+
+let inputfile = ref "";;
+
+let options = 
+  [ ( "-i",
+      Set_string(inputfile),
+      "path of the input Packages file"
+    )
+  ]
+in
+  parse
+      options
+	(function _ -> raise (Bad "Argument not allowed"))
+	"uplose -i <inputfile>";;
+
+if (!inputfile = "") then
+  raise (Bad "Missing input file");;
+
+(* the data from the Packages file *)
+let packages = read_pool_file !inputfile;;
+
+(* associates to package names the list of versions with which the package is *)
+(* mentioned in conflicts and depends relations. *)
+let versions = Hashtbl.create 10000;;
+
+(* extract a pure version number from a napkin versioned *)
+let number_of_versionend (pn,vs) =
+  match vs with
+    | Sel_ANY    -> ""
+    | Sel_LEQ v  -> v
+    | Sel_LT v   -> v
+    | Sel_GEQ v  -> v
+    | Sel_GT v   -> v
+    | Sel_EQ v   -> v
+;;
+
+(* c is a pair (packagename,version). Add it to the hashtable versions *)
+(* if it isn't already there.                                          *)
+let process_relation c =
+  let package = fst c
+  and version = number_of_versionend c
+  in
+    try
+      let oldversions = Hashtbl.find versions package
+      in
+	if not (List.mem version oldversions)
+	then Hashtbl.replace versions package (version::oldversions)
+    with
+	Not_found -> Hashtbl.add versions package [version]
+;;
+
+List.iter
+  (function p ->
+     List.iter process_relation p.pk_conflicts;
+     List.iter (List.iter process_relation) p.pk_depends)
+  packages
+;;
+
+Hashtbl.iter
+  (fun package versionlist ->
+     print_string package;
+     print_string ": ";
+     List.iter print_string versionlist;
+     print_newline())
+  versions
+