git.lisp 2.65 KB
Newer Older
1 2 3 4 5 6
(in-package :asdf-tools)

;;; Using git
;; Note that the debian git at git://git.debian.org/git/pkg-common-lisp/cl-asdf.git is stale,
;; as we currently build directly from upstream at git://common-lisp.net/projects/asdf/asdf.git

7
(defun git (cmd &rest keys)
8
  (with-asdf-dir ()
9
    (apply 'run* `(git ,@cmd) keys)))
10

11
(deftestcmd clean ()
12 13
  "clean the checkout with git clean -xfd"
  (git '(clean -xfd)))
14

15
(deftestcmd %push ()
16
  "push git branches master and release upstream"
17 18 19 20 21
  (dolist (x '((status)
               (push --tags cl.net release master)
               (push --tags github release master)
               (fetch)
               (status)))
22
    (git x)))
23

24
(deftestcmd merge-master-into-release ()
25
  "merge git branch master into release"
26 27 28 29 30
  (dolist (x '((checkout master)
               (merge release)
               (checkout release)
               (merge master)
               (checkout master)))
31
    (git x)))
32 33 34 35 36 37 38

(defparameter *wrongful-tags*
  '("1.37" ;; It's not asdf.lisp 1.37, it's asdf.lisp 1.85! 1.37 was the CVS version of the README.
    "1.1720" ;; That was a typo for 1.720
    "RELEASE" "STABLE" ;; These were misguided attempts for what should have been branches
    "README" "emp")) ;; Mistakes

39
(deftestcmd fix-local-git-tags ()
40
  "delete wrongful tags from local git repository"
41 42
  (call-without-stopping
    (mapcar (lambda (tag) (lambda () (git `(tag -d ,tag) :on-error nil))) *wrongful-tags*)))
43

44
(deftestcmd fix-remote-git-tags ((remote "origin"))
45
  "delete wrongful tags from remote git repository"
46 47
  (call-without-stopping
    (mapcar (lambda (tag) (lambda () (git `(push ,remote (:refs/tags/,tag)) :on-error nil))) *wrongful-tags*)))
48

49
(deftestcmd git-all-committed-p ()
50
  "is your checkout clean, with all files committed?"
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
  (let ((uncommitted (nth-value 2 (git '(status -s) :output :lines))))
    (success-if (null uncommitted)
                "git reports uncommitted files:~{~%  ~A~}~%" uncommitted)))

(defun get-git-branch ()
  "What is the current checked out branch?"
  (match (first (nth-value 2 (git '(status) :output :lines)))
    ((ppcre "^# On branch (.*)$" x) x)))

(deftestcmd ext-init ()
  "Populate the ext/ directory if not already populated.
Same as `make ext` in the bootstrap make script."
  (git '(submodule update --init)))

(deftestcmd ext-clear ()
  "Depopulate the ext/ directory.
Same as `make noext` in the bootstrap make script."
  (git '(submodule deinit ".")))

(deftestcmd ext-reset ()
  "Reset the ext/ directory to the contents specified by the current git checkout."
  (git '(submodule update --init)))

(deftestcmd ext-update ()
  "Update the ext/ directory to the latest version from remote repositories."
  (git '(submodule update --remote)))