(use git test srfi-1 posix)

(define repo #f)
(define repo-path "repo")
(define sha1 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
(define sha1-path "aa/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
(define ref-name "refs/heads/mimsy")
(define ref-name-symbolic "refs/heads/FOO")
(define time 1323702635)
(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 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")))

(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 (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 (current-seconds))
        (sig (make-signature name email)))
    (test-assert "make-signature without time" (signature? sig))
    (test "signature-time without time" now (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-error "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) (index-entry-ctime e))
           (test "index-entry-mtime" (vector-ref s 8) (index-entry-mtime e))
           (test "index-entry-dev"   (vector-ref s 10) (index-entry-dev e))))
       files))
    (test "index-entrycount on nonempty index"
          (length files)
          (index-entrycount i))))

(test-group "status"
  (parameterize ((current-directory repo-path))
    (let ((file    (car files))
          (content (car content)))
      (test-error "file-status on nonexistent file" (file-status "not-a-file"))
      (test-assert "file-ignored?" (not (file-ignored? repo file)))
      (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 (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 ((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-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 (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 (make-string 40 #\a)))
  (test-error "reference with nonexistent name" (reference repo "foo/bar/baz"))
  (test-assert "reference" (reference repo "refs/heads/master"))
  (test "references (listall)" 1 (length (references repo)))
  (test-assert "create-reference (oid)"
               (create-reference repo
                         target: commit
                           name: ref-name))
  (let ((ref (reference repo ref-name)))
    (test "references (oid)" 2 (length (references repo '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: ref-name-symbolic
                         symbolic: 'yes)))
  (let ((ref (reference repo ref-name-symbolic)))
    (test "references (symbolic)" 1 (length (references repo '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-target" (oid? (reference-target ref)))
    (test-assert "reference-resolve" (reference? (reference-resolve ref)))
    (test "reference-name" ref-name-symbolic (reference-name ref))
    (test "reference-name after resolve" ref-name (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-rename ref "refs/heads/mimsy"))
    (test-assert "reference-rename" (reference-rename ref "BAR"))
    (test-assert "reference after rename" (reference repo "BAR"))
    (test-error "reference with deleted reference name" (reference repo ref-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 ref-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 "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 (car (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*-size" (file-size file) (blob*-size 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" (blob*? (tree-entry->object repo e)))
           (test "tree-entry-type" 'blob (tree-entry-type e))))
       (drop files 1)
       (drop 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
                         reference: "HEAD"
                           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" (blob*? (tree-entry->object repo 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))
          (content (car content)))
      (test-assert "diff (clean workdir)" (null? (diff repo)))
      (test-assert "diff (index to clean workdir)" (null? (diff repo (index-open repo))))
      (with-output-to-file file newline #:append)
      (test "diff (dirty workdir)" 1 (length (diff repo)))
      (test "diff (index to dirty workdir)" 1 (length (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 (length (diff repo t2)))
        (test "diff (tree to index)" 1 (length (diff repo t1 (index-open repo))))
        (test "diff (tree to tree)" 1 (length (diff repo t1 t2)))
        (let ((d (car (diff repo))))
          (test-assert "diff?" (diff? d))
          (test "diff-path" file (diff-path d))
          (test "diff-status" 'modified (diff-status d))
          ;(test "diff-similarity" 0 (diff-similarity d))
          (test-assert "diff-old-file" (diff-file? (diff-old-file d)))
          (test-assert "diff-new-file" (diff-file? (diff-new-file d)))
          (let ((f (diff-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)))))
      (with-output-to-file file (cut display content)))))

(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 "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 "repositroy-ref with commit" (commit? (repository-ref repo commit)))
  (test-assert "repositroy-ref with tag" (tag? (repository-ref repo tag)))
  (test-assert "repository-ref with tree" (tree? (repository-ref repo (commit-tree commit)))))

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