cgit.sxemacs.org Git - gnus/blob - lisp/tests/gnustest-nntp.el

   1 ;;; gnustest-nntp.el --- Simple NNTP testing for Gnus
   2 ;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
   3
   4 ;; Author: David Engster <dengste@eml.cc>
   5
   6 ;; This file is not part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 3, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21 ;; Boston, MA 02110-1301, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; This test will
  26 ;;
  27 ;;   - Fire up Gnus
  28 ;;   - Connect to Gmane
  29 ;;   - Subscribe to gmane.discuss
  30 ;;   - Get its active info
  31 ;;   - Get one specific article by message-id and check its subject
  32 ;;   - Quit Gnus
  33
  34 ;;; Code:
  35
  36 (require 'ert)
  37 (require 'net-utils)
  38
  39 (defvar gnustest-nntp-server "news.gmane.org"
  40   "NNTP server used for testing.")
  41
  42 (defun gnustest-ping-host (host)
  43   "Ping HOST once and return non-nil if successful."
  44   (let* ((ping-program-options '("-c" "1"))
  45          (buf (ping host))
  46          proc)
  47     (sleep-for 0.5)
  48     (with-current-buffer buf
  49       (accept-process-output (get-buffer-process (current-buffer)) 2)
  50       (goto-char (point-min))
  51       (prog1
  52           (re-search-forward ",[ ]*1.*?received,[ ]*0" nil t)
  53         (when (setq proc (get-buffer-process (current-buffer)))
  54           (set-process-query-on-exit-flag proc nil))
  55         (kill-buffer)))))
  56
  57 (setq gnus-home-directory (concat temporary-file-directory (make-temp-name "gnus-test-")))
  58 (message "***** Using %s as temporary Gnus home." gnus-home-directory)
  59 (mkdir gnus-home-directory)
  60 (setq-default gnus-init-file nil)
  61
  62 (require 'gnus-load)
  63
  64 (setq gnus-select-method `(nntp ,gnustest-nntp-server))
  65
  66
  67 (if (null (gnustest-ping-host gnustest-nntp-server))
  68     (message "***** Skipping tests: Gmane doesn't seem to be available.")
  69   ;; Server seems to be available, so start Gnus.
  70   (message "***** Firing up Gnus; connecting to Gmane.")
  71   (gnus)
  72
  73   (ert-deftest gnustest-nntp-run-simple-test ()
  74     "Test Gnus with gmane.discuss."
  75     (set-buffer gnus-group-buffer)
  76     (gnus-group-jump-to-group "gmane.discuss")
  77     (gnus-group-get-new-news-this-group 1)
  78     (gnus-active "gmane.discuss")
  79     (message "***** Reading active from gmane.discuss.")
  80     (should (> (car (gnus-active "gmane.discuss")) 0))
  81     (should (> (cdr (gnus-active "gmane.discuss")) 10000))
  82     (gnus-group-unsubscribe-current-group)
  83     (gnus-group-set-current-level 1 1)
  84     (gnus-group-select-group 5)
  85     (message "***** Getting article with certain MID and check subject.")
  86     (set-buffer gnus-summary-buffer)
  87     (gnus-summary-refer-article "m3mxr8pa1t.fsf@quimbies.gnus.org")
  88     (should (string= (gnus-summary-article-subject) "Re: gwene idea: strip from from subject if present"))
  89     (gnus-summary-exit)
  90     (message "***** Quitting Gnus.")
  91     (set-buffer gnus-group-buffer)
  92     (gnus-group-save-newsrc)
  93     (gnus-group-exit))
  94 )
  95
  96 ;; Local Variables:
  97 ;; no-byte-compile: t
  98 ;; no-update-autoloads: t
  99 ;; End: