(use git test srfi-1 posix)

(define repo #f)
(define repo-path "repo")
(define cloned-repo #f)
(define cloned-repo-path "cloned-repo")
(define sha1 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
(define sha1-path "aa/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
(define reference-name-oid "refs/heads/mimsy")
(define reference-name-symbolic "refs/heads/FOO")
(define branch-name-one "toves")
(define branch-name-two "borogoves")
(define time 1323702635.0)
(define offset 2)
(define commit-message-one "slain the Jabberwock")
(define commit-message-two "slain the Jabberwock twice")
(define commit-message-three "slain the Jabberwock thrice")
(define tag-name-one "0.0.1-α")
(define tag-name-two "0.0.1-β")
(define tag-message-one "tagged the Jabberwock slain")
(define tag-message-two "tagged the Jabberwock slain twice")
(define note-message-one "beware the Jubjub bird on line 1871")
(define name "Bandersnatch")
(define email "banders@example.com")
(define files
  '("calloo" "callay" "frabjous" "day"))
(define content
  '("Twas brillig, and the slithy toves"
    "Did gyre and gimble in the wabe:"
    "All mimsy were the borogoves,"
    "And the mome raths outgrabe."))
(define config
  '(("core.filemode" . #t)
    ("core.repositoryformatversion" . 0)
    ("branch.master.remote" . "origin")))

(set! (file-creation-mode)
  (string->number "22" 8)) ; 33188

(test-begin "git")

(test-group "oid"
  (test-error "string->oid on malformed oid string" (string->oid "jubjub"))
  (test-assert "string->oid" (oid? (string->oid sha1)))
  (let ((oid (string->oid sha1)))
    (test "oid->string" sha1 (oid->string oid))
    (test "oid->path" sha1-path (oid->path oid))))

(test-group "signature"
  (test-error "make-signature on bad name" (make-signature "" ""))
  (test-error "make-signature on bad time" (make-signature name email "bad" "time"))
  (test-assert "make-signature" (make-signature name email time offset))
  (let ((sig (make-signature name email time offset)))
    (test "signature-time" time (exact->inexact (signature-time sig)))
    (test "signature-time-offset" offset (signature-time-offset sig)))
  ;; XXX I can imagine a horribly slow machine on which this might fail.
  (let ((now (exact->inexact (current-seconds)))
        (sig (make-signature name email)))
    (test-assert "make-signature without time" (signature? sig))
    (test "signature-time without time" now (exact->inexact (signature-time sig)))
    (test "signature-time-offset without time"
          (- (vector-ref (seconds->local-time) 9))
          (* (signature-time-offset sig) 60))))

(test-group "repository"
  (test-assert "create-repository (bare)" (create-repository repo-path 'bare))
  (test-assert "repository can be opened (bare)" (repository-open repo-path))
  (let ((repo (repository-open repo-path)))
    (test-assert "repository? (bare)" (repository? repo))
    (test-assert "repository-empty? (bare)" (repository-empty? repo))
    (test-assert "repository-bare? (bare)" (repository-bare? repo)))
  (delete-directory repo-path 'recursively)
  (test-assert "create-repository" (create-repository repo-path))
  (test-assert "repository can be opened" (repository-open repo-path))
  (let ((repo (repository-open repo-path)))
    (test-assert "repository?" (repository? repo))
    (test-assert "repository-empty?" (repository-empty? repo))
    (test-assert "repository-bare?" (not (repository-bare? repo))))
  (test "repository-working-directory"
        (repository-working-directory (repository-open repo-path))
        (normalize-pathname
         (format "~a/~a/" (current-directory) repo-path)))
  (test "repository-path"
        (repository-path (repository-open repo-path))
        (normalize-pathname
         (format "~a/~a/.git/"
                 (current-directory)
                 repo-path))))

(set! repo (repository-open repo-path))

(parameterize ((current-directory repo-path))
  (for-each (lambda (file content)
              (with-output-to-file file (cut display content)))
            files content))

(test-group "empty repository"
  (test-error "empty repo has no head" (repository-head repo))
  (test-assert "empty repo has no tags" (null? (tags repo)))
  (test-assert "empty repo has no commits" (null? (commits repo)))
  (test-assert "empty repo has no references" (null? (references repo))))

(test-group "config"
  (test-assert "config-open from nonexistent file" (config-open "not-a-config"))
  (with-output-to-file "now-a-config" void)
  (test-assert "config-open from file" (config-open "now-a-config"))
  (delete-file "now-a-config")
  (test-assert "config-open from repo" (config-open repo))
  (let ((c (config-open repo)))
    (test-assert "config?" (config? c))
    (test-error "config-get on bad key" (config-get c "not-a-value"))
    (test-error "config-get on nonexistent key" (config-get c "core.not-a-key"))
    (for-each (lambda (name value)
                (test-assert
                 (format "config-set! on value ~S" value)
                 (config-set! c name value)))
              (map car config)
              (map cdr config))
    (test "config-get on boolean" "true" (config-get c "core.filemode"))
    (test "config-get as string on boolean" "true" (config-get c "core.filemode" 'string))
    (test-error "config-get as number on boolean" (config-get c "core.filemode" 'number))
    (test "config-get as boolean on boolean" #t (config-get c "core.filemode" 'boolean))
    (test "config-get on number" "0" (config-get c "core.repositoryformatversion"))
    (test "config-get as string on number" "0" (config-get c "core.repositoryformatversion" 'string))
    (test "config-get as number on number" 0 (config-get c "core.repositoryformatversion" 'number))
    (test "config-get as boolean on number" #f (config-get c "core.repositoryformatversion" 'boolean))
    (test "config-get on string" "origin" (config-get c "branch.master.remote"))
    (test "config-get as string on string" "origin" (config-get c "branch.master.remote" 'string))
    (test-error "config-get as number on string" (config-get c "branch.master.remote" 'number))
    (test-error "config-get as boolean on string" (config-get c "branch.master.remote" 'boolean))
    (test-assert "config-unset!" (config-unset! c "branch.master.remote"))
    (test-error "config-get on unset key" (config-get c "branch.master.remote"))))

(test-group "index"
  (test-assert "index-open" (index-open repo))
  (let ((i (index-open repo)))
    (test-assert "index?" (index? i))
    (test "index-entrycount on empty index" 0 (index-entrycount i))
    (test-error "index-add nonexistent file" (index-add i "not-a-file"))
    (test-error "index-remove nonexistent file" (index-remove i "not-a-file"))
    (test-assert "index-ref on nonexistent index" (not (index-ref i -1)))
    (test-assert "index-ref on nonexistent file" (not (index-ref i "not-a-file")))
    (test-assert "index-find on nonexistent file" (not (index-find i (car files))))
    (test-assert "index-add" (index-add i (car files)))
    (test-assert "index-ref" (index-ref i 0))
    (test-assert "index-find" (index-find i (car files)))
    (test-assert "index-remove" (index-remove i (car files)))
    (parameterize ((current-directory repo-path))
      (for-each
       (lambda (file)
         (test-assert "index-add" (index-add i file))
         (test-assert "index-ref" (index-add i file))
         (let ((e (index-ref i file))
               (s (file-stat file)))
           (test-assert "index-entry?" (index-entry? e))
           (test-assert "index-entry-id" (oid? (index-entry-id e)))
           (test "index-entry-stage" 0 (index-entry-stage e))
           (test "index-entry-path" file (index-entry-path e))
           (test "index-entry-ino"   (vector-ref s 0) (index-entry-ino e))
           (test "index-entry-mode"  (vector-ref s 1) (index-entry-mode e))
           (test "index-entry-uid"   (vector-ref s 3) (index-entry-uid e))
           (test "index-entry-gid"   (vector-ref s 4) (index-entry-gid e))
           (test "index-entry-size"  (vector-ref s 5) (index-entry-size e))
           (test "index-entry-ctime" (vector-ref s 7) (exact->inexact (index-entry-ctime e)))
           (test "index-entry-mtime" (vector-ref s 8) (exact->inexact (index-entry-mtime e)))
           (test "index-entry-dev"   (vector-ref s 10) (index-entry-dev e))))
       (drop-right files 1)))
    (test-assert "index-write" (index-write i))
    (test "index-entrycount on nonempty index"
          (- (length files) 1)
          (index-entrycount i))))

(test-group "status"
  (parameterize ((current-directory repo-path))
    (test-error "file-status on nonexistent file" (file-status repo "not-a-file"))
    (test-assert "file-ignored?" (not (find (lambda (f) (file-ignored? repo f)) files)))
    (test "file-statuses" 4 (length (file-statuses repo)))
    (let ((s (car (file-statuses repo))))
      (test-assert "file-statuses (path)" (member (car s) files))
      (test "file-statuses (status)" 'index/new (cdr s)))
    (let ((file    (car files))
          (content (car content)))
      (test "file-status (single status)" 'index/new (file-status repo file))
      (with-output-to-file file newline #:append)
      (test "file-status (multiple statuses)"
            '(index/new worktree/modified)
            (file-status repo file))
      (with-output-to-file file (cut display content)))))

(test-group "commit"
  (test-error "commit with nonexistent sha" (commit repo sha1))
  (let ((now (exact->inexact (current-seconds))))
    (test-assert "create-commit (no parents)"
                 (create-commit repo
                     reference: "HEAD"
                       message: commit-message-one
                        author: (make-signature name email)))
    (test "commits (one)" 1 (length (commits repo)))
    (let ((i (index-open repo)))
      (index-add i (last files))
      (index-write i))
    (let ((c (car (commits repo))))
      (test-assert "create-commit (parent)"
                   (create-commit repo
                       reference: "HEAD"
                         message: commit-message-two
                          author: (make-signature name email)
                         parents: (list c)))
      (test "commits (two)" 2 (length (commits repo)))
      (test "commit-parent (no parents)" #f (commit-parent c))
      (test "commit-parent (parent)" (oid->string (commit-id c)) (oid->string (commit-id (commit-parent (cadr (commits repo))))))
      (test "commit-parentcount (no parents)" 0 (commit-parentcount c))
      (test "commit-parentcount (parent)" 1 (commit-parentcount (cadr (commits repo))))
      (test "commit-parents (no parents)" '() (commit-parents c))
      (test "commit-parents (parent)" 1 (length (commit-parents (cadr (commits repo)))))
      (test-assert "commit-ancestor (immediate)" (object=? c (commit-ancestor c 0)))
      (test-assert "commit-ancestor (first, no parents)" (not (commit-ancestor c 1)))
      (test-assert "commit-ancestor (first, parents)" (object=? c (commit-ancestor (cadr (commits repo)) 1)))
      (test-assert "commit?" (commit? c))
      (test-assert "object-id (commit)" (oid? (object-id c)))
      (test "object-type (commit)" 'commit (object-type c))
      (test "commit-message" commit-message-one (commit-message c))
      (test "commit-message" commit-message-two (commit-message (cadr (commits repo))))
      (test-assert "commit-id" (oid? (commit-id c)))
      (test-assert "commit-tree" (tree? (commit-tree c)))
      (test-assert "commit-author" (signature? (commit-author c)))
      (test-assert "commit-committer" (signature? (commit-committer c)))
      (test "commit-time" now (exact->inexact (commit-time c)))
      (test-assert "commit with commit" (commit repo c))
      (test-assert "commit with oid" (commit repo (commit-id c))))
    (test-assert "repository no longer empty" (not (repository-empty? repo)))
    (test-assert "repository-head" (repository-head repo))))

(set! commit (commit repo (repository-head repo)))

(test-group "reference"
  (test-error "reference with nonexistent oid" (reference repo sha1))
  (test-error "reference with nonexistent name" (reference repo "foo/bar/baz"))
  (test-assert "reference" (reference repo "refs/heads/master"))
  (test "references" 1 (length (references repo)))
  (test-assert "create-reference (oid)"
               (create-reference repo
                         target: commit
                           name: reference-name-oid))
  (test "references after one create" 2 (length (references repo)))
  (let ((ref (reference repo reference-name-oid)))
    (test-assert "reference? (oid)" (reference? ref))
    (test "reference-type (oid)" 'oid (reference-type ref))
    (test "reference-target (oid)"
          (oid->string (commit-id commit))
          (oid->string (reference-target ref)))
    (test-assert "create-reference (symbolic)"
                 (create-reference repo
                           target: ref
                             name: reference-name-symbolic
                         symbolic: 'yes)))
  (test "references after two creates" 3 (length (references repo)))
  (let ((ref (reference repo reference-name-symbolic)))
    (test-assert "reference? (symbolic)" (reference? ref))
    (test "reference-type (symbolic)" 'symbolic (reference-type ref))
    (test "reference-target (symbolic)"
          (oid->string (commit-id commit))
          (oid->string (reference-target ref)))
    (test-assert "reference?" (reference? ref))
    (test-assert "reference-branch?" (reference-branch? ref))
    (test-assert "reference-remote?" (not (reference-remote? ref)))
    (test-assert "reference-target" (oid? (reference-target ref)))
    (test-assert "reference-resolve" (reference? (reference-resolve ref)))
    (test "reference-name" reference-name-symbolic (reference-name ref))
    (test "reference-name after resolve" reference-name-oid (reference-name (reference-resolve ref)))
    (test-assert "reference-target after resolve" (oid? (reference-target (reference-resolve ref))))
    (test-error "can't set target of symbolic reference" (reference-target-set! ref commit))
    (test-error "can't rename reference to existing name" (reference-name-set! ref "refs/heads/mimsy"))
    (test-assert "reference-name-set!" (reference-name-set! ref "BAR"))
    (test-assert "reference after rename" (reference repo "BAR"))
    (test-error "reference with deleted reference name" (reference repo reference-name-symbolic)))
  (test-error "reference-delete fails on bad input" (reference-delete "mimsy!"))
  (test-error "reference-delete fails on nonexistent reference" (reference-delete (reference repo reference-name-symbolic)))
  (test-assert "reference-delete on symbolic reference" (reference-delete (reference repo "BAR")))
  (test-assert "reference-delete on non-symbolic reference" (reference-delete (reference repo "refs/heads/mimsy")))
  (test "deleted reference was actually deleted" 1 (length (references repo))))

(set! reference (car (references repo)))

(test-group "note"
  (test-error "note with nonexistent sha" (note repo sha1))
  (test "notes with no notes" 0 (length (notes repo)))
  (test-assert "create-note (default reference)"
               (create-note repo
                   message: note-message-one
                    target: commit
                    author: (make-signature name email)))
  (test-assert "note with commit" (note repo commit))
  (test-error "note with commit without note" (note repo (commit-parent commit)))
  (test-error "note with alternate reference" (note repo commit "refs/notes/jubjub"))
  (test "notes with one note" 1 (length (notes repo)))
  (test "notes with alternate reference" 0 (length (notes repo "refs/notes/jubjub")))
  (let ((note (note repo commit)))
    (test "note-message" note-message-one (note-message note))
    (test-assert "note-id" (oid? (note-id note))))
  (test-assert "delete-note (default reference)"
               (delete-note repo
                    target: commit
                    author: (make-signature name email)))
  (test-error "note after delete" (note repo commit))
  (test "notes after delete" 0 (length (notes repo))))

(test-group "branch"
  (test-error "branch with nonexistent oid" (branch repo sha1))
  (test-error "branch with nonexistent name" (branch repo branch-name-one))
  (test-assert "branch" (branch repo "master"))
  (test "branches (all)" 1 (length (branches repo)))
  (test "branches (local)" 1 (length (branches repo 'local)))
  (test "branches (remote)" 0 (length (branches repo 'remote)))
  (test-assert "create-branch"
               (create-branch repo
                      target: commit
                        name: branch-name-one))
  (test "branch" 2 (length (branches repo)))
  (let ((b (branch repo branch-name-one)))
    (test-assert "branch is a reference?" (reference? b))
    (test "branch-name" branch-name-one (branch-name b))
    (test-assert "branch-name-set!" (branch-name-set! b branch-name-two))
    (test-error "branch with new branch name" (branch repo branch-name-one))
    (test-assert "branch with old branch name" (branch repo branch-name-two)))
  (test-assert "branch-head? on head branch"
               (branch-head? (branch repo "master")))
  (test-assert "branch-head? on not head branch"
               (not (branch-head? (branch repo branch-name-two))))
  (let ((b (branch repo branch-name-two)))
    (test-assert "branch-delete" (branch-delete b))
    (test-error "deleted branch is deleted" (branch repo branch-name-two))))

(test-group "tag"
  (test-error "nonexistent tag" (tag repo tag-name-one))
  (test-error "create-tag with no arguments" (create-tag repo))
  (test-assert "create-tag (commit)"
               (create-tag repo
                   target: commit
                     name: tag-name-one
                  message: tag-message-one
                   tagger: (make-signature name email)))
  (test "tags after creation" 1 (length (tags repo)))
  (test-assert "create-tag (commit)"
               (create-tag repo
                   target: (cadr (commits repo))
                     name: tag-name-two
                  message: tag-message-two
                   tagger: (make-signature name email)))
  (test "tags after another creation" 2 (length (tags repo)))
  (let ((t (find (lambda (t)
                   (string=? (tag-name t) tag-name-one))
                 (tags repo))))
    (test-assert "tag?" (tag? t))
    (test-assert "tag-id" (oid? (tag-id t)))
    (test-assert "object-id (tag)" (oid? (object-id t)))
    (test "object-type (tag)" 'tag (object-type t))
    (test-assert "tag-peel" (commit? (tag-peel t)))
    (test-assert "tag-tagger" (signature? (tag-tagger t)))
    (test "tag-tagger (name)" name (signature-name (tag-tagger t)))
    (test "tag-tagger (email)" email (signature-email (tag-tagger t)))
    (test "tag-name" tag-name-one (tag-name t))
    (test "tag-message" tag-message-one (tag-message t))
    (test-assert "tag-target (commit)" (commit? (tag-target t)))
    (test "tag-target (oid)"
          (oid->string (commit-id commit))
          (oid->string (commit-id (tag-target t))))
    (test-assert "tag with tag" (tag repo t))
    (test-assert "tag with oid" (tag repo (tag-id t)))
    (test-error "can't delete nonexistent tag" (tag-delete "not-a-tag"))
    (test-assert "tag-delete" (tag-delete t))
    (test "tags after delete" 1 (length (tags repo)))))

(set! tag (car (tags repo)))

(test-group "blob"
  (test-error "blob with nonexistent sha" (blob repo (make-string 40 #\a)))
  (let ((t (commit-tree commit)))
    (parameterize ((current-directory repo-path))
      (for-each
       (lambda (file content)
         (let ((b (tree-entry->object repo (tree-ref t file))))
           (test-assert "blob?" (blob? b))
           (test-assert "object-id (blob)" (oid? (object-id b)))
           (test "object-type (blob)" 'blob (object-type b))
           (test "blob-length" (file-size file) (blob-length b))
           (test-assert "blob with blob" (blob repo b))
           (test-assert "blob with oid" (blob repo (object-id b)))
           (test "blob-content" content (blob->string (blob-content b)))))
       files
       content))))

(test-group "tree"
  (test-group "tree-builder"
    (let ((db (odb-open repo))
          (tb (make-tree-builder)))
      (test "tree-builder-ref on nonexistent file" #f (tree-builder-ref tb "not-a-file"))
      (test-error "tree-builder-remove on nonexistent file" (tree-builder-remove tb "not-a-file"))
      (for-each
       (lambda (file content)
         (let* ((b (odb-write db (string->blob content)))
                (e (tree-builder-insert tb b file 33188)))
           (test-assert "tree-entry?" (tree-entry? e))
           (test-assert "tree-builder-ref" (tree-builder-ref tb file))
           (test "tree-entry-name" file (tree-entry-name e))
           (test-assert "tree-entry-id" (oid? (tree-entry-id e)))
           (test-assert "tree-entry->object (tree-builder, repo)" (blob? (tree-entry->object repo e)))
           (test-error "tree-entry->object (tree-builder, no repo)" (tree-entry->object e))
           (test "tree-entry-type" 'blob (tree-entry-type e))))
       (drop-right files 1)
       (drop-right content 1))
      (let ((t (tree-builder-write repo tb)))
        (test-assert "tree? after tree-builder-write" (tree? t))
        (test-assert "create-commit (tree)"
                     (create-commit repo
                              tree: t
                           message: commit-message-three
                            author: (make-signature name email)
                           parents: (commits repo))))))
  (test-assert "create-tree" (tree? (create-tree repo)))
  (let ((t (commit-tree commit)))
    (test-assert "tree?" (tree? t))
    (test-assert "tree-id" (oid? (tree-id t)))
    (test-assert "object-id (tree)" (oid? (object-id t)))
    (test "object-type (tree)" 'tree (object-type t))
    (test "tree-entrycount" (length files) (tree-entrycount t))
    (test-assert "tree with tree" (tree repo t))
    (test-assert "tree with oid" (tree repo (tree-id t)))
    (test "tree-ref on nonexistent file" #f (tree-ref t "not/a/file"))
    (parameterize ((current-directory repo-path))
      (for-each
       (lambda (file content)
         (test-assert "tree-ref" (tree-ref t file))
         (let ((e (tree-ref t file)))
           (test-assert "tree-entry?" (tree-entry? e))
           (test-assert "tree-entry-id" (oid? (tree-entry-id e)))
           (test "tree-entry-name" file (tree-entry-name e))
           (test-assert "tree-entry->object (repo)" (blob? (tree-entry->object repo e)))
           (test-assert "tree-entry->object (no repo)" (blob? (tree-entry->object e)))
           (test "tree-entry-type" 'blob (tree-entry-type e))))
       files
       content))))

(set! tree (commit-tree commit))

(test-group "diff"
  (parameterize ((current-directory repo-path))
    (let ((file (car files))
          (line (car content)))
      (test-assert "diff (clean workdir)" (diff? (diff repo)))
      (test "diff (clean workdir)" 0 (diff-num-deltas (diff repo)))
      (test "diff (index to clean workdir)" 0 (diff-num-deltas (diff repo (index-open repo))))
      ;; Modify workdir state slightly.
      (with-output-to-file file newline #:append)
      (test-assert "diff (dirty workdir)" (diff? (diff repo)))
      (test "diff (dirty workdir)" 1 (diff-num-deltas (diff repo)))
      (test "diff (index to dirty workdir)" 1 (diff-num-deltas (diff repo (index-open repo))))
      (let* ((ts (map commit-tree (commits repo sort: 'rev)))
             (t1 (car ts))
             (t2 (cadr ts)))
        (test "diff (tree to workdir)" 1 (diff-num-deltas (diff repo t2)))
        (test "diff (tree to index)" 1 (diff-num-deltas (diff repo t1)))
        (test "diff (tree to tree)" 1 (diff-num-deltas (diff repo t1 t2)))
        (test "diff (tree to empty tree)" 4 (diff-num-deltas (diff repo t1 #f)))
        (test "diff (empty tree to tree)" 4 (diff-num-deltas (diff repo #f t1)))
        (let ((d (car (diff-deltas (diff repo)))))
          (test-assert "diff-delta?" (diff-delta? d))
          (test "diff-delta-path" file (diff-delta-path d))
          (test "diff-delta-status" 'modified (diff-delta-status d))
          (test-assert "diff-delta-old-file" (diff-file? (diff-delta-old-file d)))
          (test-assert "diff-delta-new-file" (diff-file? (diff-delta-new-file d)))
          (let ((f (diff-delta-new-file d)))
            (test-assert "diff-file-id" (oid? (diff-file-id f)))
            (test "diff-file-size" (file-size file) (diff-file-size f))
            (test "diff-file-mode" 33188 (diff-file-mode f))
            (test "diff-file-path" file (diff-file-path f)))
          (test-assert "diff-delta-hunks" (every diff-hunk? (diff-delta-hunks d)))
          (let ((h (last (diff-delta-hunks d))))
            (test-assert "diff-hunk?" (diff-hunk? h))
            (test "diff-hunk-header" "@@ -1 +1 @@\n" (diff-hunk-header h))
            (test "diff-hunk-old-lines" 1 (diff-hunk-old-lines h))
            (test "diff-hunk-new-lines" 1 (diff-hunk-new-lines h))
            (test "diff-hunk-old-start" 1 (diff-hunk-old-start h))
            (test "diff-hunk-new-start" 1 (diff-hunk-new-start h))
            (test-assert "diff-hunk-lines" (every diff-line? (diff-hunk-lines h)))
            (let ((l (last (diff-hunk-lines h))))
              (test-assert "diff-line?" (diff-line? l))
              (test "diff-line-origin" #\+ (diff-line-origin l))
              (test "diff-line-old-lineno" -1 (diff-line-old-lineno l))
              (test "diff-line-new-lineno" 1 (diff-line-new-lineno l))
              (test "diff-line-num-lines" 1 (diff-line-num-lines l))
              (test "diff-line-content-offset" 0 (diff-line-content-offset l))
              (test "diff-line-content" (string-append line "\n") (diff-line-content l))))))
      ;; Restore workdir state.
      (with-output-to-file file (cut display line)))))

(test-group "odb"
  (let ((db (odb-open repo)))
    (test-assert "odb?" (odb? db))
    (test "odb-has-object? on nonexistent object" #f (odb-has-object? db sha1))
    (test-error "odb-read on nonexistent object" (odb-read db sha1))
    (test-assert "odb-has-object? (tree)" (odb-has-object? db tree))
    (test-assert "odb-read (tree)"(odb-read db tree))
    (let ((obj (odb-read db tree)))
      (test "odb-object-type (tree)" 'tree (odb-object-type obj))
      (test "odb-object-id (tree)" (oid->string (object-id tree)) (oid->string (odb-object-id obj))))
    (for-each
     (lambda (file content)
       (let* ((bl (tree-entry->object repo (tree-ref tree file)))
              (id (oid->string (object-id bl)))
              (data (string->blob content)))
         (test-assert "odb-has-object?" (odb-has-object? db bl))
         (test-assert "odb-write" (oid? (odb-write db data)))
         (test-assert "odb-read (sha)" (odb-object? (odb-read db id)))
         (test-assert "odb-read (oid)" (odb-object? (odb-read db (string->oid id))))
         (test-assert "odb-object?" (odb-object? (odb-read db id)))
         (test-assert "odb-hash" (oid? (odb-hash data)))
         (test "odb-hash matches corresponding blob oid" id (oid->string (odb-hash data)))
         (test "odb-read & write roundtrip" id (oid->string (odb-object-id (odb-read db (odb-write db data)))))
         (test "odb-write result matches corresponding blob oid" id (oid->string (odb-write db data)))
         (let ((obj (odb-read db id)))
           (test "odb-object-data" data (odb-object-data obj))
           (test "odb-object-type" 'blob (odb-object-type obj))
           (test "odb-object-size" (blob-size data) (odb-object-size obj))
           (test "odb-object-id" id (oid->string (odb-object-id obj))))))
     files
     content)))

(test-group "revision parsing"
  (let ((revparse
         (lambda (s)
           (receive (parse-revision-specification repo s)))))
    (test "revparse with invalid revision" '(#f #f) (revparse "foo"))
    (test "revparse with invalid revisions" '(#f #f) (revparse "foo..bar"))
    (let ((revspec (revparse "HEAD")))
      (test-assert "revparse with HEAD (1st value)"
                   (object=? (car (commits repo sort: 'rev))
                             (car (revparse "HEAD"))))
      (test-assert "revparse with HEAD (2nd value)"
                   (not (cadr (revparse "HEAD")))))
    (let ((revspec (revparse (oid->string (commit-id commit)))))
      (test-assert "revparse with sha1 (1st value)"
                   (object=? commit (car revspec)))
      (test-assert "revparse with sha1 (2nd value)"
                   (not (cadr revspec))))
    (let ((revspec (revparse (string-append
                              (oid->string (commit-id commit))
                              ".."
                              (oid->string (commit-id (commit-parent commit)))))))
      (test-assert "revparse with sha1 range (1st value)"
                   (object=? commit (car revspec)))
      (test-assert "revparse with sha1 range (2nd value)"
                   (object=? (commit-parent commit) (cadr revspec))))))

(test-group "checkout"
  (test-error "checkout invalid target" (checkout repo sha1))
  (parameterize ((current-directory repo-path))
    (let ((file    (last files))
          (content (last content)))
      (test-assert "checkout head over worktree"
                   (begin (with-output-to-file file (cut display content))
                          (checkout repo)
                          (null? (file-statuses repo))))
      (test-assert "checkout tree over worktree"
                   (begin (with-output-to-file file (cut display content))
                          (checkout repo tree)
                          (null? (file-statuses repo))))
      (test-assert "checkout commit over worktree"
                   (begin (with-output-to-file file (cut display content))
                          (checkout repo commit)
                          (null? (file-statuses repo))))
      (test-assert "checkout index over worktree"
                   (let ((i (index-open repo)))
                     (with-output-to-file file (cut display "foo"))
                     (index-add i file)
                     (delete-file file)
                     (checkout repo i)
                     (eq? (file-status repo file) 'index/modified))))))

(test-group "generic object lookup"
  (test "repository-ref on nonexistent sha" #f (repository-ref repo sha1))
  (test "repository-ref on nonexistent oid" #f (repository-ref repo (string->oid sha1)))
  (test-assert "repository-ref with oid" (commit? (repository-ref repo (commit-id commit))))
  (test-assert "repository-ref with sha1" (commit? (repository-ref repo (oid->string (commit-id commit)))))
  (test-assert "repository-ref with reference" (commit? (repository-ref repo reference)))
  (test-assert "repository-ref with commit" (commit? (repository-ref repo commit)))
  (test-assert "repository-ref with tag" (tag? (repository-ref repo tag)))
  (test-assert "repository-ref with tree" (tree? (repository-ref repo (commit-tree commit)))))

(test-group "clone"
  (test-assert "clone" (clone (repository-path repo) cloned-repo-path))
  (test-assert "repository-open after clone" (repository-open cloned-repo-path)))

(set! cloned-repo (repository-open cloned-repo-path))

(test-group "remote"
  (test-assert "remote" (remote cloned-repo "origin"))
  (test "remotes" 1 (length (remotes cloned-repo)))
  (let ((r (remote cloned-repo "origin")))
    (test-assert "remote?" (remote? r))
    (test "remote-name" "origin" (remote-name r))
    (test "remote-url" (repository-path repo) (remote-url r))
    (test "remote-pushurl" #f (remote-pushurl r))
    (test-assert "remote-url-set!" (remote-url-set! r (repository-working-directory repo)))
    (test-assert "remote-pushurl-set!" (remote-pushurl-set! r (repository-path repo)))
    (test "remote-url after set" (repository-working-directory repo) (remote-url r))
    (test "remote-pushurl after set" (repository-path repo) (remote-pushurl r))
    (test-assert "remote-connect!" (remote-connect! r))
    (test-assert "remote-connected? (connected)" (remote-connected? r))
    (test-assert "remote-disconnect!" (remote-disconnect! r))
    (test-assert "remote-connected? (disconnected)" (not (remote-connected? r)))
    (test-assert "remote-download!" (remote-download! r))))

(set! remote (remote cloned-repo "origin"))

(test-group "refspec"
  (test "remote-refspecs" 1 (length (remote-refspecs remote)))
  (let ((r (car (remote-refspecs remote))))
    (test-assert "refspec?" (refspec? r))
    (test "refspec-direction" 'fetch (refspec-direction r))
    (test "refspec-source" "refs/heads/*" (refspec-source r))
    (test "refspec-destination" "refs/remotes/origin/*" (refspec-destination r))))

(test-end "git")
(delete-directory repo-path 'recursively)
(delete-directory cloned-repo-path 'recursively)
(test-exit)