From: Katsumi Yamaoka Date: Fri, 29 Jun 2012 04:15:43 +0000 (+0000) Subject: lisp/gnus/tests/: Remove X-Git-Tag: emacs-24.2.90~1199^2~290 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5437effdb836355436f5f986e46baa6a41ec0966;p=emacs.git lisp/gnus/tests/: Remove --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index e1d3b87beb5..649b5a74fb8 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,7 @@ +2012-06-29 Katsumi Yamaoka + + * tests/gnustest-nntp.el, tests/gnustest-registry.el, tests/: Remove. + 2012-06-27 Stefan Monnier * shr.el (shr-render-buffer): New command. diff --git a/lisp/gnus/tests/gnustest-nntp.el b/lisp/gnus/tests/gnustest-nntp.el deleted file mode 100644 index a00a87a208f..00000000000 --- a/lisp/gnus/tests/gnustest-nntp.el +++ /dev/null @@ -1,99 +0,0 @@ -;;; gnustest-nntp.el --- Simple NNTP testing for Gnus -;; Copyright (C) 2011-2012 Free Software Foundation, Inc. - -;; Author: David Engster - -;; This file is not 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: - -;; This test will -;; -;; - Fire up Gnus -;; - Connect to Gmane -;; - Subscribe to gmane.discuss -;; - Get its active info -;; - Get one specific article by message-id and check its subject -;; - Quit Gnus - -;;; Code: - -(require 'ert) -(require 'net-utils) - -(defvar gnustest-nntp-server "news.gmane.org" - "NNTP server used for testing.") - -(defun gnustest-ping-host (host) - "Ping HOST once and return non-nil if successful." - (let* ((ping-program-options '("-c" "1")) - (buf (ping host)) - proc) - (sleep-for 0.5) - (with-current-buffer buf - (accept-process-output (get-buffer-process (current-buffer)) 2) - (goto-char (point-min)) - (prog1 - (re-search-forward ",[ ]*1.*?received,[ ]*0" nil t) - (when (setq proc (get-buffer-process (current-buffer))) - (set-process-query-on-exit-flag proc nil)) - (kill-buffer))))) - -(setq gnus-home-directory (concat temporary-file-directory (make-temp-name "gnus-test-"))) -(message "***** Using %s as temporary Gnus home." gnus-home-directory) -(mkdir gnus-home-directory) -(setq-default gnus-init-file nil) - -(require 'gnus-load) - -(setq gnus-select-method `(nntp ,gnustest-nntp-server)) - - -(if (null (gnustest-ping-host gnustest-nntp-server)) - (message "***** Skipping tests: Gmane doesn't seem to be available.") - ;; Server seems to be available, so start Gnus. - (message "***** Firing up Gnus; connecting to Gmane.") - (gnus) - - (ert-deftest gnustest-nntp-run-simple-test () - "Test Gnus with gmane.discuss." - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group "gmane.discuss") - (gnus-group-get-new-news-this-group 1) - (gnus-active "gmane.discuss") - (message "***** Reading active from gmane.discuss.") - (should (> (car (gnus-active "gmane.discuss")) 0)) - (should (> (cdr (gnus-active "gmane.discuss")) 10000)) - (gnus-group-unsubscribe-current-group) - (gnus-group-set-current-level 1 1) - (gnus-group-select-group 5) - (message "***** Getting article with certain MID and check subject.") - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article "m3mxr8pa1t.fsf@quimbies.gnus.org") - (should (string= (gnus-summary-article-subject) "Re: gwene idea: strip from from subject if present")) - (gnus-summary-exit) - (message "***** Quitting Gnus.") - (set-buffer gnus-group-buffer) - (gnus-group-save-newsrc) - (gnus-group-exit)) -) - -;; Local Variables: -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: diff --git a/lisp/gnus/tests/gnustest-registry.el b/lisp/gnus/tests/gnustest-registry.el deleted file mode 100644 index 914b182f705..00000000000 --- a/lisp/gnus/tests/gnustest-registry.el +++ /dev/null @@ -1,221 +0,0 @@ -;;; gnustest-registry.el --- Registry and Gnus registry testing for Gnus -;; Copyright (C) 2011-2012 Free Software Foundation, Inc. - -;; Author: Ted Zlatanov - -;; This file is not 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: - -;;; Code: - -(eval-when-compile - (when (null (ignore-errors (require 'ert))) - (defmacro* ert-deftest (name () &body docstring-keys-and-body)))) - -(ignore-errors - (require 'ert)) - -(require 'registry) -(require 'gnus-registry) - -(ert-deftest gnustest-registry-instantiation-test () - (should (registry-db "Testing"))) - -(ert-deftest gnustest-registry-match-test () - (let ((entry '((hello "goodbye" "bye") (blank)))) - - (message "Testing :regex matching") - (should (registry--match :regex entry '((hello "nye" "bye")))) - (should (registry--match :regex entry '((hello "good")))) - (should-not (registry--match :regex entry '((hello "nye")))) - (should-not (registry--match :regex entry '((hello)))) - - (message "Testing :member matching") - (should (registry--match :member entry '((hello "bye")))) - (should (registry--match :member entry '((hello "goodbye")))) - (should-not (registry--match :member entry '((hello "good")))) - (should-not (registry--match :member entry '((hello "nye")))) - (should-not (registry--match :member entry '((hello))))) - (message "Done with matching testing.")) - -(defun gnustest-registry-make-testable-db (n &optional name file) - (let* ((db (registry-db - (or name "Testing") - :file (or file "unused") - :max-hard n - :max-soft 0 ; keep nothing not precious - :precious '(extra more-extra) - :tracked '(sender subject groups)))) - (dotimes (i n) - (registry-insert db i `((sender "me") - (subject "about you") - (more-extra) ; empty data key should be pruned - ;; first 5 entries will NOT have this extra data - ,@(when (< 5 i) (list (list 'extra "more data"))) - (groups ,(number-to-string i))))) - db)) - -(ert-deftest gnustest-registry-usage-test () - (let* ((n 100) - (db (gnustest-registry-make-testable-db n))) - (message "size %d" n) - (should (= n (registry-size db))) - (message "max-hard test") - (should-error (registry-insert db "new" '())) - (message "Individual lookup") - (should (= 58 (caadr (registry-lookup db '(1 58 99))))) - (message "Grouped individual lookup") - (should (= 3 (length (registry-lookup db '(1 58 99))))) - (when (boundp 'lexical-binding) - (message "Individual lookup (breaks before lexbind)") - (should (= 58 - (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99))))) - (message "Grouped individual lookup (breaks before lexbind)") - (should (= 3 - (length (registry-lookup-breaks-before-lexbind db - '(1 58 99)))))) - (message "Search") - (should (= n (length (registry-search db :all t)))) - (should (= n (length (registry-search db :member '((sender "me")))))) - (message "Secondary index search") - (should (= n (length (registry-lookup-secondary-value db 'sender "me")))) - (should (equal '(74) (registry-lookup-secondary-value db 'groups "74"))) - (message "Delete") - (should (registry-delete db '(1) t)) - (decf n) - (message "Search after delete") - (should (= n (length (registry-search db :all t)))) - (message "Secondary search after delete") - (should (= n (length (registry-lookup-secondary-value db 'sender "me")))) - ;; (message "Pruning") - ;; (let* ((tokeep (registry-search db :member '((extra "more data")))) - ;; (count (- n (length tokeep))) - ;; (pruned (registry-prune db)) - ;; (prune-count (length pruned))) - ;; (message "Expecting to prune %d entries and pruned %d" - ;; count prune-count) - ;; (should (and (= count 5) - ;; (= count prune-count)))) - (message "Done with usage testing."))) - -(ert-deftest gnustest-registry-persistence-test () - (let* ((n 100) - (tempfile (make-temp-file "registry-persistence-")) - (name "persistence tester") - (db (gnustest-registry-make-testable-db n name tempfile)) - size back) - (message "Saving to %s" tempfile) - (eieio-persistent-save db) - (setq size (nth 7 (file-attributes tempfile))) - (message "Saved to %s: size %d" tempfile size) - (should (< 0 size)) - (with-temp-buffer - (insert-file-contents-literally tempfile) - (should (looking-at (concat ";; Object " - name - "\n;; EIEIO PERSISTENT OBJECT")))) - (message "Reading object back") - (setq back (eieio-persistent-read tempfile)) - (should back) - (message "Read object back: %d keys, expected %d==%d" - (registry-size back) n (registry-size db)) - (should (= (registry-size back) n)) - (should (= (registry-size back) (registry-size db))) - (delete-file tempfile)) - (message "Done with persistence testing.")) - -(ert-deftest gnustest-gnus-registry-misc-test () - (should-error (gnus-registry-extract-addresses '("" ""))) - - (should (equal '("Ted Zlatanov " - "noname " - "noname " - "noname ") - (gnus-registry-extract-addresses - (concat "Ted Zlatanov , " - "ed , " ; "ed" is not a valid name here - "cyd@stupidchicken.com, " - "tzz@lifelogs.com"))))) - -(ert-deftest gnustest-gnus-registry-usage-test () - (let* ((n 100) - (tempfile (make-temp-file "gnus-registry-persist")) - (db (gnus-registry-make-db tempfile)) - (gnus-registry-db db) - back size) - (message "Adding %d keys to the test Gnus registry" n) - (dotimes (i n) - (let ((id (number-to-string i))) - (gnus-registry-handle-action id - (if (>= 50 i) "fromgroup" nil) - "togroup" - (when (>= 70 i) - (format "subject %d" (mod i 10))) - (when (>= 80 i) - (format "sender %d" (mod i 10)))))) - (message "Testing Gnus registry size is %d" n) - (should (= n (registry-size db))) - (message "Looking up individual keys (registry-lookup)") - (should (equal (loop for e - in (mapcar 'cadr - (registry-lookup db '("20" "83" "72"))) - collect (assq 'subject e) - collect (assq 'sender e) - collect (assq 'group e)) - '((subject "subject 0") (sender "sender 0") (group "togroup") - (subject) (sender) (group "togroup") - (subject) (sender "sender 2") (group "togroup")))) - - (message "Looking up individual keys (gnus-registry-id-key)") - (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup"))) - (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4"))) - (message "Trying to insert a duplicate key") - (should-error (gnus-registry-insert db "55" '())) - (message "Looking up individual keys (gnus-registry-get-or-make-entry)") - (should (gnus-registry-get-or-make-entry "22")) - (message "Saving the Gnus registry to %s" tempfile) - (should (gnus-registry-save tempfile db)) - (setq size (nth 7 (file-attributes tempfile))) - (message "Saving the Gnus registry to %s: size %d" tempfile size) - (should (< 0 size)) - (with-temp-buffer - (insert-file-contents-literally tempfile) - (should (looking-at (concat ";; Object " - "Gnus Registry" - "\n;; EIEIO PERSISTENT OBJECT")))) - (message "Reading Gnus registry back") - (setq back (eieio-persistent-read tempfile)) - (should back) - (message "Read Gnus registry back: %d keys, expected %d==%d" - (registry-size back) n (registry-size db)) - (should (= (registry-size back) n)) - (should (= (registry-size back) (registry-size db))) - (delete-file tempfile) - (message "Pruning Gnus registry to 0 by setting :max-soft") - (oset db :max-soft 0) - (registry-prune db) - (should (= (registry-size db) 0))) - (message "Done with Gnus registry usage testing.")) - -(provide 'gnustest-registry) - -;; Local Variables: -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: