Update copyright year to 2016
[gnus] / lisp / tests / gnustest-nntp.el
1 ;;; gnustest-nntp.el --- Simple NNTP testing for Gnus
2 ;; Copyright (C) 2011-2016 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.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;; This test will
24 ;;
25 ;;   - Fire up Gnus
26 ;;   - Connect to Gmane
27 ;;   - Subscribe to gmane.discuss
28 ;;   - Get its active info
29 ;;   - Get one specific article by message-id and check its subject
30 ;;   - Quit Gnus
31
32 ;;; Code:
33
34 (require 'ert)
35 (require 'net-utils)
36
37 (defvar gnustest-nntp-server "news.gmane.org"
38   "NNTP server used for testing.")
39
40 (defun gnustest-ping-host (host)
41   "Ping HOST once and return non-nil if successful."
42   (let* ((ping-program-options '("-c" "1"))
43          (buf (ping host))
44          proc)
45     ;; sleep-for does not work correctly with async processes running
46     (call-process "sleep" nil nil nil "2")
47     (with-current-buffer buf
48       (accept-process-output (get-buffer-process (current-buffer)) 2)
49       (goto-char (point-min))
50       (prog1
51           (re-search-forward ",[ ]*1.*?received,[ ]*0" nil t)
52         (when (setq proc (get-buffer-process (current-buffer)))
53           (set-process-query-on-exit-flag proc nil))
54         (kill-buffer)))))
55
56 (setq gnus-home-directory (concat temporary-file-directory (make-temp-name "gnus-test-")))
57 (message "***** Using %s as temporary Gnus home." gnus-home-directory)
58 (mkdir gnus-home-directory)
59 (setq-default gnus-init-file nil)
60
61 (require 'gnus-load)
62
63 (setq gnus-select-method `(nntp ,gnustest-nntp-server))
64
65
66 (if (null (gnustest-ping-host gnustest-nntp-server))
67     (message "***** Skipping tests: Gmane doesn't seem to be available.")
68   ;; Server seems to be available, so start Gnus.
69   (message "***** Firing up Gnus; connecting to Gmane.")
70   (gnus)
71
72   (ert-deftest gnustest-nntp-run-simple-test ()
73     "Test Gnus with gmane.discuss."
74     (set-buffer gnus-group-buffer)
75     (gnus-group-jump-to-group "gmane.discuss")
76     (gnus-group-get-new-news-this-group 1)
77     (gnus-active "gmane.discuss")
78     (message "***** Reading active from gmane.discuss.")
79     (should (> (car (gnus-active "gmane.discuss")) 0))
80     (should (> (cdr (gnus-active "gmane.discuss")) 10000))
81     (gnus-group-unsubscribe-current-group)
82     (gnus-group-set-current-level 1 1)
83     (gnus-group-select-group 5)
84     (message "***** Getting article with certain MID and check subject.")
85     (set-buffer gnus-summary-buffer)
86     (gnus-summary-refer-article "m3mxr8pa1t.fsf@quimbies.gnus.org")
87     (should (string= (gnus-summary-article-subject) "Re: gwene idea: strip from from subject if present"))
88     (gnus-summary-exit)
89     (message "***** Quitting Gnus.")
90     (set-buffer gnus-group-buffer)
91     (gnus-group-save-newsrc)
92     (gnus-group-exit))
93 )
94
95 ;; Local Variables:
96 ;; no-byte-compile: t
97 ;; no-update-autoloads: t
98 ;; End: