137 lines
4.4 KiB
EmacsLisp
137 lines
4.4 KiB
EmacsLisp
;;; bzr-tests.el --- Automated regression tests for bzr
|
|
|
|
;; Copyright (C) 2007, 2008 Stephen Leake
|
|
|
|
;; Author: Stephen Leake
|
|
|
|
;; adapted from xmtn-tests.el
|
|
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2 of the License, or
|
|
;; (at your option) any later version.
|
|
;;
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this file; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
|
|
;; Boston, MA 02110-1301 USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Automated regression tests for bzr-dvc.
|
|
|
|
;;; Code:
|
|
|
|
;; These tests require elunit.el from dvc/lisp/contrib, originally
|
|
;; from http://dev.technomancy.us/phil/wiki/ElUnit
|
|
|
|
(require 'bzr-dvc)
|
|
(require 'cl)
|
|
(require 'dvc-tests-utils "tests/dvc-tests-utils.el")
|
|
(require 'elunit)
|
|
|
|
;;; This is preferable over separate set-up and tear-down functions
|
|
;;; since it allows us to make use of `unwind-protect' and dynamic
|
|
;;; bindings.
|
|
|
|
(defun bzr-tests--call-with-test-environment (bzr--body)
|
|
"Initialize a bzr workspace, call BODY"
|
|
(lexical-let ((body bzr--body)
|
|
(temp-dir nil))
|
|
(unwind-protect
|
|
(progn
|
|
(setq temp-dir (file-name-as-directory (make-temp-file "bzr-tests-" t)))
|
|
(let ((default-directory temp-dir))
|
|
(dvc-run-dvc-sync 'bzr '("init"))
|
|
(funcall body)
|
|
(dvc-tests-wait-async)))
|
|
(if temp-dir
|
|
;; If this delete doesn't succeed, there is a real problem,
|
|
;; so we don't try to handle the error.
|
|
(dired-delete-file temp-dir 'always)))))
|
|
|
|
(defun bzr-tests--call-with-test-history (bzr--body)
|
|
"Create a test environment with one file with some change
|
|
history. Call BODY with one key arg :file-name; the file name of
|
|
the test file."
|
|
(lexical-let ((body bzr--body))
|
|
(bzr-tests--call-with-test-environment
|
|
(function*
|
|
(lambda ()
|
|
(lexical-let ((file-name "file-1"))
|
|
(with-temp-file file-name (insert "a\n"))
|
|
(bzr-add file-name)
|
|
(dvc-run-dvc-sync 'bzr '("commit" "--message" "\"commit 1\""))
|
|
(with-temp-file file-name (insert "b\n"))
|
|
(dvc-run-dvc-sync 'bzr '("commit" "--message" "\"commit 2\""))
|
|
(funcall body
|
|
:file-name file-name)))))))
|
|
|
|
(defmacro* bzr-tests--with-test-environment ((&rest keys) &body body)
|
|
(declare (indent 1) (debug sexp body))
|
|
`(bzr-tests--call-with-test-environment (function* (lambda (,@keys) ,@body))))
|
|
|
|
(defmacro* bzr-tests--with-test-history ((&rest keys) &body body)
|
|
(declare (indent 1) (debug sexp body))
|
|
`(bzr-tests--call-with-test-history (function* (lambda (,@keys) ,@body))))
|
|
|
|
|
|
(defsuite bzr
|
|
(log
|
|
(save-window-excursion
|
|
(bzr-tests--with-test-history (&key &allow-other-keys)
|
|
;; The test is simply that this doesn't crash.
|
|
(dvc-log)
|
|
(dvc-tests-wait-async) ; let log display
|
|
(dvc-revlist-show-item))))
|
|
|
|
(file-diff
|
|
;; The test is simply that this doesn't crash.
|
|
(save-window-excursion
|
|
(bzr-tests--with-test-history (&key file-name &allow-other-keys)
|
|
(find-file file-name)
|
|
(unwind-protect
|
|
(progn
|
|
(insert "x")
|
|
(save-excursion
|
|
(call-interactively #'dvc-file-diff)))
|
|
(revert-buffer t t)))))
|
|
|
|
(diff
|
|
;; The test is simply that this doesn't crash.
|
|
(save-window-excursion
|
|
(bzr-tests--with-test-history (&key file-name &allow-other-keys)
|
|
(find-file file-name)
|
|
(insert "x")
|
|
(write-file file-name)
|
|
(call-interactively #'dvc-diff))))
|
|
|
|
(diff-from-revlog
|
|
;; The test is simply that this doesn't crash.
|
|
(save-window-excursion
|
|
(bzr-tests--with-test-history (&key &allow-other-keys)
|
|
(dvc-changelog)
|
|
(dvc-tests-wait-async) ; let log display
|
|
(dvc-revision-next)
|
|
(dvc-revlist-diff))))
|
|
|
|
)
|
|
;;(elunit "bzr")
|
|
|
|
(defsuite bzr-one
|
|
(log
|
|
(save-window-excursion
|
|
(bzr-tests--with-test-history
|
|
(&key &allow-other-keys)
|
|
(dvc-diff))))
|
|
)
|
|
;;(elunit "bzr-one")
|
|
|
|
(provide 'bzr-tests)
|
|
;;; bzr-tests.el ends here
|