Merge pull request #100 from samoht/master

Fix various regressions in Sync.clone

.travis.yml

@@ -2,8 +2,12 @@ language: c
 install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh
 script: bash -ex .travis-opam.sh
 env:
-  - OCAML_VERSION=4.01 DEPOTS=cohttp
-  - OCAML_VERSION=latest
-  - OCAML_VERSION=latest
-    DEPOPTS="mirage-http mirage-flow mirage-types-lwt channel cmdliner"
-    TESTS=false
+  global:
+    - PACKAGE=git
+  matrix:
+    - OCAML_VERSION=4.01 DEPOTS=cohttp
+    - OCAML_VERSION=4.01
+    - OCAML_VERSION=4.02
+      DEPOPTS="mirage-http mirage-flow mirage-types-lwt channel cmdliner"
+      TESTS=false
+    - OCAML_VERSION=4.02 TESTS=false REVDEPS=*

CHANGES.md

@@ -1,3 +1,16 @@
+### 1.6.0 (2015-07-11)
+
+* Allow some references to contain pointer to other references (#96)
+* Improve the support for 32bit architectures (#97)
+* Add `Reference.pp_head_contents` and `Reference.equal_head_contents`.
+* Remove `Store.clear` and replace it by `Memory.clear`, `Memory.clear_all`
+  and `FS.remove`. This let users have a finer control over the memory
+  consumption of the program over time (related to #90)
+* Rename all `pp_hum` functions into `pp`.
+* Fix regression in `Sync.fetch` and add unit-tests (running only in slow mode).
+* Fix reading of `.git/HEAD` when the contents is a commit hash.
+* Depends on `Stringext` for all the extra string function needed.
+
 ### 1.5.3 (2015-07-10)
 
 * Fix listing of packed references (#98)

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        git
-Version:     1.5.3
+Version:     1.6.0
 Synopsis:    A low-level interface to Git in pure OCaml
 Authors:     Thomas Gazagnaire
 License:     ISC
@@ -26,7 +26,7 @@ Library git
                      Object, Object_type, Store, Search, Gri,
                      Memory, FS, Packed_refs
   BuildDepends:      mstruct, dolog, ocamlgraph, zip, nocrypto, uri,
-                     lwt, hex
+                     lwt, hex, stringext
 
 Library git_top
   Path:             lib/top

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: a4a985c6ac5e966966f38c5311876856)
+# DO NOT EDIT (digest: e091b6058d4207e403bc545d417f795e)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -47,6 +47,7 @@ true: annot, bin_annot
 <lib/*.ml{,i,y}>: pkg_mstruct
 <lib/*.ml{,i,y}>: pkg_nocrypto
 <lib/*.ml{,i,y}>: pkg_ocamlgraph
+<lib/*.ml{,i,y}>: pkg_stringext
 <lib/*.ml{,i,y}>: pkg_uri
 <lib/*.ml{,i,y}>: pkg_zip
 # Library git_top
@@ -61,6 +62,7 @@ true: annot, bin_annot
 <lib/http/*.ml{,i,y}>: pkg_mstruct
 <lib/http/*.ml{,i,y}>: pkg_nocrypto
 <lib/http/*.ml{,i,y}>: pkg_ocamlgraph
+<lib/http/*.ml{,i,y}>: pkg_stringext
 <lib/http/*.ml{,i,y}>: pkg_uri
 <lib/http/*.ml{,i,y}>: pkg_uri.services
 <lib/http/*.ml{,i,y}>: pkg_zip
@@ -76,6 +78,7 @@ true: annot, bin_annot
 <lib/unix/*.ml{,i,y}>: pkg_mstruct
 <lib/unix/*.ml{,i,y}>: pkg_nocrypto
 <lib/unix/*.ml{,i,y}>: pkg_ocamlgraph
+<lib/unix/*.ml{,i,y}>: pkg_stringext
 <lib/unix/*.ml{,i,y}>: pkg_uri
 <lib/unix/*.ml{,i,y}>: pkg_uri.services
 <lib/unix/*.ml{,i,y}>: pkg_zip
@@ -97,6 +100,7 @@ true: annot, bin_annot
 <lib/mirage/*.ml{,i,y}>: pkg_mstruct
 <lib/mirage/*.ml{,i,y}>: pkg_nocrypto
 <lib/mirage/*.ml{,i,y}>: pkg_ocamlgraph
+<lib/mirage/*.ml{,i,y}>: pkg_stringext
 <lib/mirage/*.ml{,i,y}>: pkg_uri
 <lib/mirage/*.ml{,i,y}>: pkg_uri.services
 <lib/mirage/*.ml{,i,y}>: pkg_zip
@@ -113,6 +117,7 @@ true: annot, bin_annot
 <bin/ogit.{native,byte}>: pkg_mstruct
 <bin/ogit.{native,byte}>: pkg_nocrypto
 <bin/ogit.{native,byte}>: pkg_ocamlgraph
+<bin/ogit.{native,byte}>: pkg_stringext
 <bin/ogit.{native,byte}>: pkg_uri
 <bin/ogit.{native,byte}>: pkg_uri.services
 <bin/ogit.{native,byte}>: pkg_zip
@@ -129,6 +134,7 @@ true: annot, bin_annot
 <bin/*.ml{,i,y}>: pkg_mstruct
 <bin/*.ml{,i,y}>: pkg_nocrypto
 <bin/*.ml{,i,y}>: pkg_ocamlgraph
+<bin/*.ml{,i,y}>: pkg_stringext
 <bin/*.ml{,i,y}>: pkg_uri
 <bin/*.ml{,i,y}>: pkg_uri.services
 <bin/*.ml{,i,y}>: pkg_zip
@@ -155,6 +161,7 @@ true: annot, bin_annot
 <lib_test/test.{native,byte}>: pkg_mstruct
 <lib_test/test.{native,byte}>: pkg_nocrypto
 <lib_test/test.{native,byte}>: pkg_ocamlgraph
+<lib_test/test.{native,byte}>: pkg_stringext
 <lib_test/test.{native,byte}>: pkg_uri
 <lib_test/test.{native,byte}>: pkg_uri.services
 <lib_test/test.{native,byte}>: pkg_zip
@@ -181,6 +188,7 @@ true: annot, bin_annot
 <lib_test/*.ml{,i,y}>: pkg_mstruct
 <lib_test/*.ml{,i,y}>: pkg_nocrypto
 <lib_test/*.ml{,i,y}>: pkg_ocamlgraph
+<lib_test/*.ml{,i,y}>: pkg_stringext
 <lib_test/*.ml{,i,y}>: pkg_uri
 <lib_test/*.ml{,i,y}>: pkg_uri.services
 <lib_test/*.ml{,i,y}>: pkg_zip

bin/ogit.ml

@@ -386,6 +386,9 @@ let read_tree = {
     Term.(mk read $ backend $ commit)
 }
 
+let reference_of_raw branch =
+  Reference.of_raw ("refs/heads/" ^ Reference.to_raw branch)
+
 (* CLONE *)
 let clone = {
   name = "clone";
@@ -399,7 +402,14 @@ let clone = {
         Arg.(some int) None in
     let bare =
       mk_flag ["bare"] "Do not expand the filesystem." in
-    let clone (module S: Store.S) deepen bare unpack remote dir =
+    let branch =
+      mk_opt ["b"; "branch"] "BRANCH"
+        "Instead of pointing the newly created HEAD to the branch pointed to by \
+         the cloned repository's HEAD, point to $(b, name) branch instead. In a \
+         non-bare repository, this is the branch that will be checked out."
+        Arg.(some reference) None
+    in
+    let clone (module S: Store.S) deepen bare branch unpack remote dir =
       let dir = match dir with
         | Some d -> d
         | None   ->
@@ -419,8 +429,12 @@ let clone = {
       let module Sync = Sync.Make(S) in
       run begin
         S.create ~root:dir ()   >>= fun t ->
+        let head = match branch with
+          | None   -> None
+          | Some b -> Some (Reference.Ref (reference_of_raw b))
+        in
         printf "Cloning into '%s' ...\n%!" (Filename.basename (S.root t));
-        Sync.clone t ?deepen ~unpack remote >>= fun r ->
+        Sync.clone t ?deepen ~unpack ?head remote >>= fun r ->
         if not bare then match r.Result.head with
           | None      -> Lwt.return_unit
           | Some head ->
@@ -430,7 +444,8 @@ let clone = {
         else
           Lwt.return_unit
       end in
-    Term.(mk clone $ backend $ depth $ bare $ unpack $ remote $ directory)
+    Term.(mk clone $ backend $ depth $ bare $ branch $
+          unpack $ remote $ directory)
 }
 
 (* FETCH *)
@@ -486,8 +501,7 @@ let push = {
         S.create ()                 >>= fun t ->
         S.read_reference t branch   >>= fun b ->
         let branch = match b with
-          | None   -> Reference.of_raw
-                        ("refs/heads/" ^ Reference.to_raw branch)
+          | None   -> reference_of_raw branch
           | Some _ -> branch in
         Sync.push t ~branch remote >>= fun s ->
         printf "%s\n" (Result.pretty_push s);

lib/FS.ml

@@ -43,6 +43,7 @@ end
 
 module type S = sig
   include Store.S
+  val remove: t -> unit Lwt.t
   val create_file: t -> string -> Tree.perm -> Blob.t -> unit Lwt.t
   val entry_of_file: t -> Index.t ->
     string -> Tree.perm -> SHA.Blob.t -> Blob.t -> Index.entry option Lwt.t
@@ -130,8 +131,8 @@ module Make (IO: IO) = struct
     end >>= fun root ->
     Lwt.return { root; level }
 
-  let clear t =
-    Log.info "clear %s" t.root;
+  let remove t =
+    Log.info "remove %s" t.root;
     IO.remove (sprintf "%s/.git" t.root)
 
   (* Loose objects *)
@@ -472,16 +473,18 @@ module Make (IO: IO) = struct
       (fun () -> IO.remove file)
       (fun _ -> Lwt.return_unit)
 
-  let read_reference t ref =
+  let rec read_reference t ref =
     let file = file_of_ref t ref in
-    IO.file_exists file >>= function
-    | true ->
+    IO.file_exists file >>= fun exists ->
+    if exists then
       (* We use `IO.read_file` here as the contents of the file might
          change. *)
-      IO.read_file file >>= fun hex ->
-      let hex = String.trim (Cstruct.to_string hex) in
-      Lwt.return (Some (SHA.Commit.of_hex hex))
-    | false ->
+      IO.read_file file >>= fun buf ->
+      let str = Cstruct.to_string buf in
+      match Reference.head_contents_of_string str with
+      | Reference.SHA x -> Lwt.return (Some x)
+      | Reference.Ref r -> read_reference t r
+    else
       let packed_refs = packed_refs t in
       IO.file_exists packed_refs >>= function
       | false -> Lwt.return_none
@@ -499,15 +502,9 @@ module Make (IO: IO) = struct
     | true ->
       (* We use `IO.read_file` here as the contents of the file might
          change. *)
-      IO.read_file file >>= fun str ->
-      let str = Cstruct.to_string str in
-      let contents = match Misc.string_split ~on:' ' str with
-        | [sha1]  -> Reference.SHA (SHA.Commit.of_hex sha1)
-        | [_;ref] -> Reference.Ref (Reference.of_raw ref)
-        | _       ->
-          failwith (sprintf "read_head: %s is not a valid HEAD contents" str)
-      in
-      Lwt.return (Some contents)
+      IO.read_file file >|= fun buf ->
+      let str = Cstruct.to_string buf in
+      Some (Reference.head_contents_of_string str)
     | false ->
       Lwt.return None
 

lib/FS.mli

@@ -20,6 +20,9 @@ module type S = sig
 
   include Store.S
 
+  val remove: t -> unit Lwt.t
+  (** Remove all the contents of the store. *)
+
   val create_file: t -> string -> Tree.perm -> Blob.t -> unit Lwt.t
   (** Create a file on the filesystem, with the given mode. *)
 

lib/META

@@ -1,15 +1,15 @@
 # OASIS_START
-# DO NOT EDIT (digest: 104bec6eebe91ca92d23ea23f627a872)
-version = "1.5.3"
+# DO NOT EDIT (digest: 12563177197ed08d09a3e54e388e995b)
+version = "1.6.0"
 description = "A low-level interface to Git in pure OCaml"
-requires = "mstruct dolog ocamlgraph zip nocrypto uri lwt hex"
+requires = "mstruct dolog ocamlgraph zip nocrypto uri lwt hex stringext"
 archive(byte) = "git.cma"
 archive(byte, plugin) = "git.cma"
 archive(native) = "git.cmxa"
 archive(native, plugin) = "git.cmxs"
 exists_if = "git.cma"
 package "unix" (
- version = "1.5.3"
+ version = "1.6.0"
  description = "A low-level interface to Git in pure OCaml"
  requires = "git git.http lwt cohttp.lwt lwt.unix conduit.lwt-unix"
  archive(byte) = "git-unix.cma"
@@ -20,7 +20,7 @@ package "unix" (
 )
 
 package "top" (
- version = "1.5.3"
+ version = "1.6.0"
  description = "Toplevel printers for Git values"
  requires = "git"
  archive(byte) = "git_top.cma"
@@ -31,7 +31,7 @@ package "top" (
 )
 
 package "mirage" (
- version = "1.5.3"
+ version = "1.6.0"
  description = "A low-level interface to Git in pure OCaml"
  requires =
  "git git.http mirage-types.lwt io-page conduit.mirage dns.mirage mirage-http mirage-flow channel"
@@ -43,7 +43,7 @@ package "mirage" (
 )
 
 package "http" (
- version = "1.5.3"
+ version = "1.6.0"
  description = "A low-level interface to Git in pure OCaml"
  requires = "git lwt cohttp.lwt uri.services"
  archive(byte) = "git-http.cma"