Browse code
feat: initial tests for git objects, commit components
Ed L authored on 16/11/2020 08:13:10Showing 7 changed files
- commit.lisp
- docker-run/main.lisp
- package.lisp
- tests/git-objects.lisp
- tests/sample-git-objects/hello-world-commit.git-obj
- tests/sample-git-objects/hello-world-tree.git-obj
- tests/tests.lisp
| ... | ... |
@@ -29,6 +29,14 @@ |
| 29 | 29 |
(cadr |
| 30 | 30 |
(fw.lu:v-assoc :tree (metadata object) |
| 31 | 31 |
:test 'string-equal)))) |
| 32 |
+(defmethod component ((component (eql :author)) (object git-commit)) |
|
| 33 |
+ (second |
|
| 34 |
+ (fw.lu:v-assoc :author (metadata object) |
|
| 35 |
+ :test 'string-equal))) |
|
| 36 |
+(defmethod component ((component (eql :committer)) (object git-commit)) |
|
| 37 |
+ (second |
|
| 38 |
+ (fw.lu:v-assoc :committer (metadata object) |
|
| 39 |
+ :test 'string-equal))) |
|
| 32 | 40 |
(defmethod component ((component (eql :parents)) (object git-commit)) |
| 33 | 41 |
(coerce (remove-if-not (serapeum:op |
| 34 | 42 |
(string= "parent" _)) |
| 11 | 12 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,64 @@ |
| 1 |
+(defpackage :fwoar.cl-git.git-objects |
|
| 2 |
+ (:use :cl ) |
|
| 3 |
+ (:export )) |
|
| 4 |
+(in-package :fwoar.cl-git.git-objects) |
|
| 5 |
+ |
|
| 6 |
+(fiveam:def-suite :fwoar.cl-git.git-objects |
|
| 7 |
+ :description "testing branch resolution" |
|
| 8 |
+ :in :fwoar.cl-git) |
|
| 9 |
+(fiveam:in-suite :fwoar.cl-git.git-objects) |
|
| 10 |
+ |
|
| 11 |
+(fw.lu:defclass+ fake-ref () |
|
| 12 |
+ ((%repo :initarg :repo :reader repo) |
|
| 13 |
+ (%hash :initarg :hash :reader hash))) |
|
| 14 |
+(defmethod fwoar.cl-git::ref ((repo (eql :the-repo)) hash) |
|
| 15 |
+ (fake-ref repo hash)) |
|
| 16 |
+ |
|
| 17 |
+ |
|
| 18 |
+(fiveam:def-test basic-commit () |
|
| 19 |
+ (let ((fwoar.cl-git::*git-repository* :the-repo) |
|
| 20 |
+ (object (fwoar.cl-git::extract-loose-object |
|
| 21 |
+ nil |
|
| 22 |
+ (asdf:system-relative-pathname |
|
| 23 |
+ :cl-git |
|
| 24 |
+ "tests/sample-git-objects/hello-world-commit.git-obj")))) |
|
| 25 |
+ (5am:is (typep object 'fwoar.cl-git::git-commit)) |
|
| 26 |
+ (5am:is (equal "hello, git! |
|
| 27 |
+" |
|
| 28 |
+ (fwoar.cl-git:component :message object))) |
|
| 29 |
+ (5am:is (equal () |
|
| 30 |
+ (fwoar.cl-git:component :parents object))) |
|
| 31 |
+ (5am:is (equal "L Edgley <foo@bar.com> 1605513585 -0800" |
|
| 32 |
+ (fwoar.cl-git:component :author object))) |
|
| 33 |
+ (5am:is (equal "Ed L <el-github@elangley.org> 1605513585 -0800" |
|
| 34 |
+ (fwoar.cl-git:component :committer object))) |
|
| 35 |
+ (5am:is (equal () |
|
| 36 |
+ (fwoar.cl-git:component :parents object))) |
|
| 37 |
+ (5am:is (equal "1da546ab4697b719efb62f11fd785d6ad3b226d2" |
|
| 38 |
+ (hash (fwoar.cl-git:component :tree object)))) |
|
| 39 |
+ (5am:is (equal :the-repo |
|
| 40 |
+ (repo (fwoar.cl-git:component :tree object)))) |
|
| 41 |
+ (5am:is (equal '(("author" "L Edgley <foo@bar.com> 1605513585 -0800")
|
|
| 42 |
+ ("committer" "Ed L <el-github@elangley.org> 1605513585 -0800")
|
|
| 43 |
+ ("tree" "1da546ab4697b719efb62f11fd785d6ad3b226d2"))
|
|
| 44 |
+ (coerce (sort (copy-seq (fwoar.cl-git::metadata object)) |
|
| 45 |
+ 'string-lessp |
|
| 46 |
+ :key 'car) |
|
| 47 |
+ 'list))))) |
|
| 48 |
+ |
|
| 49 |
+(fiveam:def-test basic-tree () |
|
| 50 |
+ (let ((object (fwoar.cl-git::extract-loose-object |
|
| 51 |
+ nil |
|
| 52 |
+ (asdf:system-relative-pathname |
|
| 53 |
+ :cl-git |
|
| 54 |
+ "tests/sample-git-objects/hello-world-tree.git-obj")))) |
|
| 55 |
+ (5am:is (typep object 'fwoar.cl-git::git-tree)) |
|
| 56 |
+ (let* ((entries (fwoar.cl-git::entries object)) |
|
| 57 |
+ (entry (progn (5am:is (= (length entries) 1)) |
|
| 58 |
+ (car entries)))) |
|
| 59 |
+ (5am:is (equal "4b5fa63702dd96796042e92787f464e28f09f17d" |
|
| 60 |
+ (fwoar.cl-git:component :hash entry))) |
|
| 61 |
+ (5am:is (equal "a" |
|
| 62 |
+ (fwoar.cl-git:component :name entry))) |
|
| 63 |
+ (5am:is (equal "100644" |
|
| 64 |
+ (fwoar.cl-git:component :mode entry)))))) |