1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-26 10:49:33 +00:00

* automated/Makefile.in (setwins): Include the 'data' subdirectory.

* automated/package-x-test.el: New file.

* automated/package-test.el: New file.

* automated/data/package: New directory, with test examples.

* lisp/emacs-lisp/package-x.el (package-upload-buffer-internal): Adapt
to `package-desc-version' being a list.  Use
`package--ac-desc-version' to retrieve version from a package
archive element.
This commit is contained in:
Dmitry Gutov 2013-06-27 13:26:54 +04:00
parent 1e0726398d
commit 9ea5cf9fbd
15 changed files with 656 additions and 4 deletions

View File

@ -1,3 +1,10 @@
2013-06-27 Dmitry Gutov <dgutov@yandex.ru>
* emacs-lisp/package-x.el (package-upload-buffer-internal): Adapt
to `package-desc-version' being a list. Use
`package--ac-desc-version' to retrieve version from a package
archive element.
2013-06-27 Juanma Barranquero <lekktu@gmail.com>
New experimental feature to save&restore window and frame setup.

View File

@ -204,12 +204,12 @@ if it exists."
package--default-summary)
(read-string "Description of package: ")
(package-desc-summary pkg-desc)))
(pkg-version (package-desc-version pkg-desc))
(split-version (package-desc-version pkg-desc))
(commentary
(pcase file-type
(`single (lm-commentary))
(`tar nil))) ;; FIXME: Get it from the README file.
(split-version (version-to-list pkg-version))
(pkg-version (package-version-join split-version))
(pkg-buffer (current-buffer)))
;; Get archive-contents from ARCHIVE-URL if it's non-nil, or
@ -223,7 +223,7 @@ if it exists."
(let ((elt (assq pkg-name (cdr contents))))
(if elt
(if (version-list-<= split-version
(package-desc-version (cdr elt)))
(package--ac-desc-version (cdr elt)))
(error "New package has smaller version: %s" pkg-version)
(setcdr elt new-desc))
(setq contents (cons (car contents)

View File

@ -1,3 +1,13 @@
2013-06-27 Daniel Hackney <dan@haxney.org>
* automated/Makefile.in (setwins): Include the 'data' subdirectory.
* automated/package-x-test.el: New file.
* automated/package-test.el: New file.
* automated/data/package: New directory, with test examples.
2013-06-27 Glenn Morris <rgm@gnu.org>
* automated/python-tests.el (python-tests-with-temp-file):

View File

@ -50,7 +50,7 @@ emacs = EMACSLOADPATH=$(lispsrc):$(test) LC_ALL=C $(EMACS) $(EMACSOPT)
# Common command to find subdirectories
setwins=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* ) ;; \
case $$file in */.* | */.*/* | */=* | ./data* ) ;; \
*) wins="$$wins $$file" ;; \
esac; \
done

View File

@ -0,0 +1,10 @@
(1
(simple-single .
[(1 3)
nil "A single-file package with no dependencies" single])
(simple-depend .
[(1 0)
((simple-single (1 3))) "A single-file package with a dependency." single])
(multi-file .
[(0 2 3)
nil "Example of a multi-file tar package" tar]))

Binary file not shown.

View File

@ -0,0 +1 @@
This is a bare-bones readme file for the multi-file package.

View File

@ -0,0 +1,13 @@
(1
(simple-single .
[(1 4)
nil "A single-file package with no dependencies" single])
(simple-depend .
[(1 0)
((simple-single (1 3))) "A single-file package with a dependency." single])
(new-pkg .
[(1 0)
nil "A package only seen after "updating" archive-contents" single])
(multi-file .
[(0 2 3)
nil "Example of a multi-file tar package" tar]))

View File

@ -0,0 +1,18 @@
;;; new-pkg.el --- A package only seen after "updating" archive-contents
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.0
;;; Commentary:
;; This will only show up after updating "archive-contents".
;;; Code:
(defun new-pkg-frob ()
"Ignore me."
(ignore))
(provide 'new-pkg)
;;; new-pkg.el ends here

View File

@ -0,0 +1,36 @@
;;; simple-single.el --- A single-file package with no dependencies
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.4
;; Keywords: frobnicate
;;; Commentary:
;; This package provides a minor mode to frobnicate and/or bifurcate
;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
;; and all your dreams will come true.
;;
;; This is a new, updated version.
;;; Code:
(defgroup simple-single nil "Simply a file"
:group 'lisp)
(defcustom simple-single-super-sunday nil
"How great is this?
Default changed to `nil'."
:type 'boolean
:group 'simple-single
:package-version "1.4")
(defvar simple-single-sudo-sandwich nil
"Make a sandwich?")
;;;###autoload
(define-minor-mode simple-single-mode
"It does good things to stuff")
(provide 'simple-single)
;;; simple-single.el ends here

View File

@ -0,0 +1,17 @@
;;; simple-depend.el --- A single-file package with a dependency.
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.0
;; Keywords: frobnicate
;; Package-Requires: ((simple-single "1.3"))
;;; Commentary:
;; Depends on another package.
;;; Code:
(defvar simple-depend "Value"
"Some trivial code")
;;; simple-depend.el ends here

View File

@ -0,0 +1,32 @@
;;; simple-single.el --- A single-file package with no dependencies
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.3
;; Keywords: frobnicate
;;; Commentary:
;; This package provides a minor mode to frobnicate and/or bifurcate
;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
;; and all your dreams will come true.
;;; Code:
(defgroup simple-single nil "Simply a file"
:group 'lisp)
(defcustom simple-single-super-sunday t
"How great is this?"
:type 'boolean
:group 'simple-single)
(defvar simple-single-sudo-sandwich nil
"Make a sandwich?")
;;;###autoload
(define-minor-mode simple-single-mode
"It does good things to stuff")
(provide 'simple-single)
;;; simple-single.el ends here

View File

@ -0,0 +1,3 @@
This package provides a minor mode to frobnicate and/or bifurcate
any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
and all your dreams will come true.

398
test/automated/package-test.el Executable file
View File

@ -0,0 +1,398 @@
;;; package-test.el --- Tests for the Emacs package system
;; Author: Daniel Hackney <dan@haxney.org>
;; Version: 1.0
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; You may want to run this from a separate Emacs instance from your
;; main one, because a bug in the code below could mess with your
;; installed packages.
;; Run this in a clean Emacs session using:
;;
;; $ emacs -Q --batch -L . -l package-test.el -l ert -f ert-run-tests-batch-and-exit
;;; Code:
(require 'package)
(require 'ert)
(require 'cl-lib)
(defvar package-test-user-dir nil
"Directory to use for installing packages during testing.")
(defvar package-test-file-dir (file-name-directory (or load-file-name
buffer-file-name))
"Directory of the actual \"package-test.el\" file.")
(defvar simple-single-desc
(package-desc-create :name 'simple-single
:version '(1 3)
:summary "A single-file package with no dependencies"
:kind 'single)
"Expected `package-desc' parsed from simple-single-1.3.el.")
(defvar simple-single-desc-1-4
(package-desc-create :name 'simple-single
:version '(1 4)
:summary "A single-file package with no dependencies"
:kind 'single)
"Expected `package-desc' parsed from simple-single-1.4.el.")
(defvar simple-depend-desc
(package-desc-create :name 'simple-depend
:version '(1 0)
:summary "A single-file package with a dependency."
:kind 'single
:reqs '((simple-single (1 3))))
"Expected `package-desc' parsed from simple-depend-1.0.el.")
(defvar multi-file-desc
(package-desc-create :name 'multi-file
:version '(0 2 3)
:summary "Example of a multi-file tar package"
:kind 'tar)
"Expected `package-desc' from \"multi-file-0.2.3.tar\".")
(defvar new-pkg-desc
(package-desc-create :name 'new-pkg
:version '(1 0)
:kind 'single)
"Expected `package-desc' parsed from new-pkg-1.0.el.")
(defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir)
"Base directory of package test files.")
(defvar package-test-fake-contents-file
(expand-file-name "archive-contents" package-test-data-dir)
"Path to a static copy of \"archive-contents\".")
(defvar package-test-built-file-suffixes '(".tar" "/dir" "/*.info")
"Remove these files when cleaning up a built package.")
(cl-defmacro with-package-test ((&optional &key file
basedir
install
update-news
upload-base)
&rest body)
"Set up temporary locations and variables for testing."
(declare (indent 1))
`(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t))
(package-user-dir package-test-user-dir)
(package-archives `(("gnu" . ,package-test-data-dir)))
(old-yes-no-defn (symbol-function 'yes-or-no-p))
(old-pwd default-directory)
package--initialized
package-alist
,@(if update-news
'(package-update-news-on-upload t)
(list (cl-gensym)))
,@(if upload-base
'((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t))
(package-archive-upload-base package-test-archive-upload-base))
(list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind `nil'
(unwind-protect
(progn
,(if basedir `(cd ,basedir))
(setf (symbol-function 'yes-or-no-p) #'(lambda (&rest r) t))
(unless (file-directory-p package-user-dir)
(mkdir package-user-dir))
,@(when install
`((package-initialize)
(package-refresh-contents)
(mapc 'package-install ,install)))
(with-temp-buffer
,(if file
`(insert-file-contents ,file))
,@body))
(when (file-directory-p package-test-user-dir)
(delete-directory package-test-user-dir t))
(when (and (boundp 'package-test-archive-upload-base)
(file-directory-p package-test-archive-upload-base))
(delete-directory package-test-archive-upload-base t))
(setf (symbol-function 'yes-or-no-p) old-yes-no-defn)
(cd old-pwd))))
(defmacro with-fake-help-buffer (&rest body)
"Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer."
`(with-temp-buffer
(help-mode)
;; Trick `help-buffer' into using the temp buffer.
(let ((help-xref-following t))
,@body)))
(defun package-test-install-texinfo (file)
"Install from texinfo FILE.
FILE should be a .texinfo file relative to the current
`default-directory'"
(require 'info)
(let* ((full-file (expand-file-name file))
(info-file (replace-regexp-in-string "\\.texi\\'" ".info" full-file))
(old-info-defn (symbol-function 'Info-revert-find-node)))
(require 'info)
(setf (symbol-function 'Info-revert-find-node) #'ignore)
(with-current-buffer (find-file-literally full-file)
(unwind-protect
(progn
(require 'makeinfo)
(makeinfo-buffer)
;; Give `makeinfo-buffer' a chance to finish
(while compilation-in-progress
(sit-for 0.1))
(call-process "ginstall-info" nil nil nil
(format "--info-dir=%s" default-directory)
(format "%s" info-file)))
(kill-buffer)
(setf (symbol-function 'Info-revert-find-node) old-info-defn)))))
(defun package-test-strip-version (dir)
(replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir)))
(defun package-test-suffix-matches (base suffix-list)
"Return file names matching BASE concatenated with each item in SUFFIX-LIST"
(cl-mapcan
'(lambda (item) (file-expand-wildcards (concat base item)))
suffix-list))
(defun package-test-cleanup-built-files (dir)
"Remove files which were the result of creating a tar archive.
DIR is the base name of the package directory, without the trailing slash"
(let* ((pkg-dirname (file-name-nondirectory dir)))
(dolist (file (package-test-suffix-matches dir package-test-built-file-suffixes))
(delete-file file))))
(defun package-test-search-tar-file (filename)
"Search the current buffer's `tar-parse-info' variable for FILENAME.
Must called from within a `tar-mode' buffer."
(cl-dolist (header tar-parse-info)
(let ((tar-name (tar-header-name header)))
(when (string= tar-name filename)
(cl-return t)))))
(defun package-test-desc-version-string (desc)
"Return the package version as a string."
(package-version-join (package-desc-version desc)))
(ert-deftest package-test-desc-from-buffer ()
"Parse an elisp buffer to get a `package-desc' object."
(with-package-test (:basedir "data/package" :file "simple-single-1.3.el")
(should (equal (package-buffer-info) simple-single-desc)))
(with-package-test (:basedir "data/package" :file "simple-depend-1.0.el")
(should (equal (package-buffer-info) simple-depend-desc)))
(with-package-test (:basedir "data/package"
:file "multi-file-0.2.3.tar")
(tar-mode)
(should (equal (package-tar-file-info) multi-file-desc))))
(ert-deftest package-test-install-single ()
"Install a single file without using an archive."
(with-package-test (:basedir "data/package" :file "simple-single-1.3.el")
(should (package-install-from-buffer))
(package-initialize)
(should (package-installed-p 'simple-single))
(let* ((simple-pkg-dir (file-name-as-directory
(expand-file-name
"simple-single-1.3"
package-test-user-dir)))
(autoloads-file (expand-file-name "simple-single-autoloads.el"
simple-pkg-dir)))
(should (file-directory-p simple-pkg-dir))
(with-temp-buffer
(insert-file-contents (expand-file-name "simple-single-pkg.el"
simple-pkg-dir))
(should (string= (buffer-string)
(concat "(define-package \"simple-single\" \"1.3\" "
"\"A single-file package "
"with no dependencies\" 'nil)\n"))))
(should (file-exists-p autoloads-file))
(should-not (get-file-buffer autoloads-file)))))
(ert-deftest package-test-install-dependency ()
"Install a package which includes a dependency."
(with-package-test ()
(package-initialize)
(package-refresh-contents)
(package-install 'simple-depend)
(should (package-installed-p 'simple-single))
(should (package-installed-p 'simple-depend))))
(ert-deftest package-test-refresh-contents ()
"Parse an \"archive-contents\" file."
(with-package-test ()
(package-initialize)
(package-refresh-contents)
(should (eq 3 (length package-archive-contents)))))
(ert-deftest package-test-install-single-from-archive ()
"Install a single package from a package archive."
(with-package-test ()
(package-initialize)
(package-refresh-contents)
(package-install 'simple-single)))
(ert-deftest package-test-install-multifile ()
"Check properties of the installed multi-file package."
(with-package-test (:basedir "data/package" :install '(multi-file))
(let ((autoload-file
(expand-file-name "multi-file-autoloads.el"
(expand-file-name
"multi-file-0.2.3"
package-test-user-dir)))
(installed-files '("dir" "multi-file.info" "multi-file-sub.elc"
"multi-file-autoloads.el" "multi-file.elc"))
(autoload-forms '("^(defvar multi-file-custom-var"
"^(custom-autoload 'multi-file-custom-var"
"^(autoload 'multi-file-mode"))
(pkg-dir (file-name-as-directory
(expand-file-name
"multi-file-0.2.3"
package-test-user-dir))))
(package-refresh-contents)
(should (package-installed-p 'multi-file))
(with-temp-buffer
(insert-file-contents-literally autoload-file)
(dolist (fn installed-files)
(should (file-exists-p (expand-file-name fn pkg-dir))))
(dolist (re autoload-forms)
(goto-char (point-min))
(should (re-search-forward re nil t)))))))
(ert-deftest package-test-update-listing ()
"Ensure installed package status is updated."
(with-package-test ()
(let ((buf (package-list-packages)))
(search-forward-regexp "^ +simple-single")
(package-menu-mark-install)
(package-menu-execute)
(should (package-installed-p 'simple-single))
(switch-to-buffer "*Packages*")
(goto-char (point-min))
(should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
(goto-char (point-min))
(should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))
(kill-buffer buf))))
(ert-deftest package-test-update-archives ()
"Test updating package archives."
(with-package-test ()
(let ((buf (package-list-packages)))
(package-menu-refresh)
(search-forward-regexp "^ +simple-single")
(package-menu-mark-install)
(package-menu-execute)
(should (package-installed-p 'simple-single))
(let ((package-test-data-dir
(expand-file-name "data/package/newer-versions" package-test-file-dir)))
(setq package-archives `(("gnu" . ,package-test-data-dir)))
(package-menu-refresh)
;; New version should be available and old version should be installed
(goto-char (point-min))
(should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t))
(should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
(goto-char (point-min))
(should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t))
(package-menu-mark-upgrades)
(package-menu-execute)
(package-menu-refresh)
(should (package-installed-p 'simple-single '(1 4)))))))
(ert-deftest package-test-describe-package ()
"Test displaying help for a package."
(require 'finder-inf)
;; Built-in
(with-fake-help-buffer
(describe-package '5x5)
(goto-char (point-min))
(should (search-forward "5x5 is a built-in package." nil t))
(should (search-forward "Status: Built-in." nil t))
(should (search-forward "Summary: simple little puzzle game" nil t))
(should (search-forward "The aim of 5x5" nil t)))
;; Installed
(with-package-test ()
(package-initialize)
(package-refresh-contents)
(package-install 'simple-single)
(with-fake-help-buffer
(describe-package 'simple-single)
(goto-char (point-min))
(should (search-forward "simple-single is an installed package." nil t))
(should (search-forward
(format "Status: Installed in `%s/'."
(expand-file-name "simple-single-1.3" package-user-dir))
nil t))
(should (search-forward "Version: 1.3" nil t))
(should (search-forward "Summary: A single-file package with no dependencies"
nil t))
;; No description, though. Because at this point we don't know
;; what archive the package originated from, and we don't have
;; its readme file saved.
)))
(ert-deftest package-test-describe-not-installed-package ()
"Test displaying of the readme for not-installed package."
(with-package-test ()
(package-initialize)
(package-refresh-contents)
(with-fake-help-buffer
(describe-package 'simple-single)
(goto-char (point-min))
(should (search-forward "This package provides a minor mode to frobnicate"
nil t)))))
(ert-deftest package-test-describe-non-installed-package ()
"Test displaying of the readme for non-installed package."
(with-package-test ()
(package-initialize)
(package-refresh-contents)
(with-fake-help-buffer
(describe-package 'simple-single)
(goto-char (point-min))
(should (search-forward "This package provides a minor mode to frobnicate"
nil t)))))
(ert-deftest package-test-describe-non-installed-multi-file-package ()
"Test displaying of the readme for non-installed multi-file package."
(with-package-test ()
(package-initialize)
(package-refresh-contents)
(with-fake-help-buffer
(describe-package 'multi-file)
(goto-char (point-min))
(should (search-forward "This is a bare-bones readme file for the multi-file"
nil t)))))
(provide 'package-test)
;;; package-test.el ends here

107
test/automated/package-x-test.el Executable file
View File

@ -0,0 +1,107 @@
;;; package-test.el --- Tests for the Emacs package system
;; Author: Daniel Hackney <dan@haxney.org>
;; Version: 1.0
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Run this from a separate Emacs instance from your main one as it
;; messes with the package archive files. In fact, it wouldn't be a
;; bad idea to back up your whole package archive before testing!
;; Run this in a clean Emacs session using:
;;
;; $ emacs -Q --batch -L . -l package-x-test.el -f ert-run-tests-batch-and-exit
;;; Code:
(require 'package-x)
(require 'ert)
(require 'cl-lib)
;; package-test is not normally in `load-path', so temporarily set
;; `load-path' to contain the current directory.
(let ((load-path (append (list (file-name-directory (or load-file-name
buffer-file-name)))
load-path)))
(require 'package-test))
(defvar package-x-test--single-archive-entry-1-3
(package-desc-create :name 'simple-single
:version '(1 3)
:summary "A single-file package with no dependencies"
:kind 'single)
"Expected contents of the archive entry from the \"simple-single\" package.")
(defvar package-x-test--single-archive-entry-1-4
(package-desc-create :name 'simple-single
:version '(1 4)
:summary "A single-file package with no dependencies"
:kind 'single)
"Expected contents of the archive entry from the updated \"simple-single\" package.")
(ert-deftest package-x-test-upload-buffer ()
"Test creating an \"archive-contents\" file"
(with-package-test (:basedir "data/package"
:file "simple-single-1.3.el"
:upload-base t)
(package-upload-buffer)
(should (file-exists-p (expand-file-name "archive-contents"
package-archive-upload-base)))
(should (file-exists-p (expand-file-name "simple-single-1.3.el"
package-archive-upload-base)))
(should (file-exists-p (expand-file-name "simple-single-readme.txt"
package-archive-upload-base)))
(let (archive-contents)
(with-temp-buffer
(insert-file-contents
(expand-file-name "archive-contents"
package-archive-upload-base))
(setq archive-contents
(package-read-from-string
(buffer-substring (point-min) (point-max)))))
(should (equal archive-contents
(list 1 package-x-test--single-archive-entry-1-3))))))
(ert-deftest package-x-test-upload-new-version ()
"Test uploading a new version of a package"
(with-package-test (:basedir "data/package"
:file "simple-single-1.3.el"
:upload-base t)
(package-upload-buffer)
(with-temp-buffer
(insert-file-contents "newer-versions/simple-single-1.4.el")
(package-upload-buffer))
(let (archive-contents)
(with-temp-buffer
(insert-file-contents
(expand-file-name "archive-contents"
package-archive-upload-base))
(setq archive-contents
(package-read-from-string
(buffer-substring (point-min) (point-max)))))
(should (equal archive-contents
(list 1 package-x-test--single-archive-entry-1-4))))))
(provide 'package-x-test)
;;; package-x-test.el ends here