mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-17 18:37:33 +00:00
Add tests for time.el
* lisp/time.el (display-time-update--load) (display-time-update--mail): Extract from... (display-time-update): ...here. * test/lisp/time-tests.el: New file.
This commit is contained in:
Stefan Kangas
parent
a497b8e4a4
commit
b69f363698
2 changed files with 131 additions and 51 deletions
108
lisp/time.el
108
lisp/time.el
|
|
@ -284,6 +284,60 @@ Switches from the 1 to 5 to 15 minute load average, and then back to 1."
|
|||
(defvar month)
|
||||
(defvar dayname))
|
||||
|
||||
(defun display-time-update--load ()
|
||||
(if (null display-time-load-average)
|
||||
""
|
||||
(condition-case ()
|
||||
;; Do not show values less than
|
||||
;; `display-time-load-average-threshold'.
|
||||
(if (> (* display-time-load-average-threshold 100)
|
||||
(nth display-time-load-average (load-average)))
|
||||
""
|
||||
;; The load average number is mysterious, so
|
||||
;; provide some help.
|
||||
(let ((str (format " %03d"
|
||||
(nth display-time-load-average
|
||||
(load-average)))))
|
||||
(propertize
|
||||
(concat (substring str 0 -2) "." (substring str -2))
|
||||
'local-map (make-mode-line-mouse-map
|
||||
'mouse-2 'display-time-next-load-average)
|
||||
'mouse-face 'mode-line-highlight
|
||||
'help-echo (concat
|
||||
"System load average for past "
|
||||
(if (= 0 display-time-load-average)
|
||||
"1 minute"
|
||||
(if (= 1 display-time-load-average)
|
||||
"5 minutes"
|
||||
"15 minutes"))
|
||||
"; mouse-2: next"))))
|
||||
(error ""))))
|
||||
|
||||
(defun display-time-update--mail ()
|
||||
(let ((mail-spool-file (or display-time-mail-file
|
||||
(getenv "MAIL")
|
||||
(concat rmail-spool-directory
|
||||
(user-login-name)))))
|
||||
(cond
|
||||
(display-time-mail-function
|
||||
(funcall display-time-mail-function))
|
||||
(display-time-mail-directory
|
||||
(display-time-mail-check-directory))
|
||||
((and (stringp mail-spool-file)
|
||||
(or (null display-time-server-down-time)
|
||||
;; If have been down for 20 min, try again.
|
||||
(time-less-p 1200 (time-since
|
||||
display-time-server-down-time))))
|
||||
(let ((start-time (current-time)))
|
||||
(prog1
|
||||
(display-time-file-nonempty-p mail-spool-file)
|
||||
;; Record whether mail file is accessible.
|
||||
(setq display-time-server-down-time
|
||||
(let ((end-time (current-time)))
|
||||
(and (time-less-p 20 (time-subtract
|
||||
end-time start-time))
|
||||
(float-time end-time))))))))))
|
||||
|
||||
(defun display-time-update ()
|
||||
"Update the display-time info for the mode line.
|
||||
However, don't redisplay right now.
|
||||
|
|
@ -291,57 +345,9 @@ However, don't redisplay right now.
|
|||
This is used for things like Rmail `g' that want to force an
|
||||
update which can wait for the next redisplay."
|
||||
(let* ((now (current-time))
|
||||
(time (current-time-string now))
|
||||
(load (if (null display-time-load-average)
|
||||
""
|
||||
(condition-case ()
|
||||
;; Do not show values less than
|
||||
;; `display-time-load-average-threshold'.
|
||||
(if (> (* display-time-load-average-threshold 100)
|
||||
(nth display-time-load-average (load-average)))
|
||||
""
|
||||
;; The load average number is mysterious, so
|
||||
;; provide some help.
|
||||
(let ((str (format " %03d"
|
||||
(nth display-time-load-average
|
||||
(load-average)))))
|
||||
(propertize
|
||||
(concat (substring str 0 -2) "." (substring str -2))
|
||||
'local-map (make-mode-line-mouse-map
|
||||
'mouse-2 'display-time-next-load-average)
|
||||
'mouse-face 'mode-line-highlight
|
||||
'help-echo (concat
|
||||
"System load average for past "
|
||||
(if (= 0 display-time-load-average)
|
||||
"1 minute"
|
||||
(if (= 1 display-time-load-average)
|
||||
"5 minutes"
|
||||
"15 minutes"))
|
||||
"; mouse-2: next"))))
|
||||
(error ""))))
|
||||
(mail-spool-file (or display-time-mail-file
|
||||
(getenv "MAIL")
|
||||
(concat rmail-spool-directory
|
||||
(user-login-name))))
|
||||
(mail (cond
|
||||
(display-time-mail-function
|
||||
(funcall display-time-mail-function))
|
||||
(display-time-mail-directory
|
||||
(display-time-mail-check-directory))
|
||||
((and (stringp mail-spool-file)
|
||||
(or (null display-time-server-down-time)
|
||||
;; If have been down for 20 min, try again.
|
||||
(time-less-p 1200 (time-since
|
||||
display-time-server-down-time))))
|
||||
(let ((start-time (current-time)))
|
||||
(prog1
|
||||
(display-time-file-nonempty-p mail-spool-file)
|
||||
;; Record whether mail file is accessible.
|
||||
(setq display-time-server-down-time
|
||||
(let ((end-time (current-time)))
|
||||
(and (time-less-p 20 (time-subtract
|
||||
end-time start-time))
|
||||
(float-time end-time)))))))))
|
||||
(time (current-time-string now))
|
||||
(load (display-time-update--load))
|
||||
(mail (display-time-update--mail))
|
||||
(24-hours (substring time 11 13))
|
||||
(hour (string-to-number 24-hours))
|
||||
(12-hours (int-to-string (1+ (% (+ hour 11) 12))))
|
||||
|
|
|
|||
74
test/lisp/time-tests.el
Normal file
74
test/lisp/time-tests.el
Normal file
|
|
@ -0,0 +1,74 @@
|
|||
;;; time-tests.el --- Tests for time.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Stefan Kangas <stefankangas@gmail.com>
|
||||
|
||||
;; 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 of the License, 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. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
(require 'time)
|
||||
|
||||
(ert-deftest time-tests-display-time-mail-check-directory ()
|
||||
(let ((display-time-mail-directory (ert-resource-directory)))
|
||||
(should (display-time-mail-check-directory))))
|
||||
|
||||
(ert-deftest time-tests-display-time-update--load ()
|
||||
(let ((display-time-load-average 1)
|
||||
(display-time-load-average-threshold 0))
|
||||
(display-time-next-load-average)
|
||||
(should (string-match (rx string-start " " (+ digit "."))
|
||||
(display-time-update--load))))
|
||||
(let (display-time-load-average)
|
||||
(should (equal (display-time-update--load) ""))))
|
||||
|
||||
(ert-deftest time-tests-display-time-update ()
|
||||
(let ((display-time-load-average 1)
|
||||
(display-time-load-average-threshold 0)
|
||||
display-time-string)
|
||||
(display-time-update)
|
||||
(should (string-match (rx string-start (? digit) digit ":" digit digit
|
||||
(? (| "AM" "PM"))
|
||||
" " (+ digit "."))
|
||||
display-time-string))))
|
||||
|
||||
(ert-deftest time-tests-display-time-file-nonempty-p ()
|
||||
(should (display-time-file-nonempty-p (ert-resource-file "non-empty")))
|
||||
(should-not (display-time-file-nonempty-p "/non/existent")))
|
||||
|
||||
(ert-deftest time-tests-world-clock ()
|
||||
(save-window-excursion
|
||||
(world-clock)
|
||||
(should (equal (buffer-name) world-clock-buffer-name))
|
||||
(should (string-match "New York" (buffer-string)))))
|
||||
|
||||
(ert-deftest time-tests-world-clock/revert-buffer-works ()
|
||||
(save-window-excursion
|
||||
(world-clock)
|
||||
(revert-buffer)
|
||||
(should (string-match "New York" (buffer-string)))))
|
||||
|
||||
(ert-deftest time-tests-emacs-uptime ()
|
||||
(should (string-match "^[0-9.]+ seconds?$" (emacs-uptime "%S"))))
|
||||
|
||||
(ert-deftest time-tests-emacs-init-time ()
|
||||
(should (string-match "^[0-9.]+ seconds?$" (emacs-init-time))))
|
||||
|
||||
(provide 'time-tests)
|
||||
;;; time-tests.el ends here
|
||||
Loading…
Reference in a new issue