1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
| | ;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
;; Copyright (C) 2023 Free Software Foundation, Inc.
;; 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:
;;; Code:
(require 'ert)
(require 'erc-stamp)
(require 'erc-goodies) ; for `erc-make-read-only'
;; These display-oriented tests are brittle because many factors
;; influence how text properties are applied. We should just
;; rework these into full scenarios.
(defun erc-stamp-tests--insert-right (test)
(let ((val (list 0 0))
(erc-insert-modify-hook '(erc-add-timestamp))
(erc-insert-post-hook '(erc-make-read-only)) ; see comment above
(erc-timestamp-only-if-changed-flag nil)
;;
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
(advice-add 'erc-format-timestamp :filter-args
(lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
'((name . ert-deftest--erc-timestamp-use-align-to)))
(with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
(erc-mode)
(erc-munge-invisibility-spec)
(setq erc-server-process (start-process "p" (current-buffer)
"sleep" "1")
erc-input-marker (make-marker)
erc-insert-marker (make-marker))
(set-process-query-on-exit-flag erc-server-process nil)
(set-marker erc-insert-marker (point-max))
(erc-display-prompt)
(funcall test)
(when noninteractive
(kill-buffer)))
(advice-remove 'erc-format-timestamp
'ert-deftest--erc-timestamp-use-align-to)))
(ert-deftest erc-timestamp-use-align-to--nil ()
(erc-stamp-tests--insert-right
(lambda ()
(ert-info ("nil, normal")
(let ((erc-timestamp-use-align-to nil))
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
(rx "begin" (+ "\t") (* " ") " [") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
(should (eql ?\n (char-after (field-end (point))))))
;; The option `erc-timestamp-right-column' is normally nil by
;; default, but it's a convenient stand in for a sufficiently
;; small `erc-fill-column' (we can force a line break without
;; involving that module).
(should-not erc-timestamp-right-column)
(ert-info ("nil, overlong (hard wrap)")
(let ((erc-timestamp-use-align-to nil)
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
(should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
;; Field excludes leading whitespace (arguably undesirable).
(should (eql ?\[ (char-after (1+ (field-beginning (point))))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
(ert-deftest erc-timestamp-use-align-to--t ()
(erc-stamp-tests--insert-right
(lambda ()
(ert-info ("t, normal")
(let ((erc-timestamp-use-align-to t))
(let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
(should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
(ert-info ("t, overlong (hard wrap)")
(let ((erc-timestamp-use-align-to t)
(erc-timestamp-right-column 20))
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
(should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
;; Field starts *after* leading space (arguably bad).
(should (eql ?\[ (char-after (1+ (field-beginning (point))))))
(should (eql ?\n (char-after (field-end (point)))))))))
(ert-deftest erc-timestamp-use-align-to--integer ()
(erc-stamp-tests--insert-right
(lambda ()
(ert-info ("integer, normal")
(let ((erc-timestamp-use-align-to 1))
(let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Space not added because included in format string.
(should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
(ert-info ("integer, overlong (hard wrap)")
(let ((erc-timestamp-use-align-to 1)
(erc-timestamp-right-column 20))
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; No hard wrap
(should (search-forward "oooo [" nil t))
;; Field starts at leading space.
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
(ert-deftest erc-timestamp-use-align-to--margin ()
(erc-stamp-tests--insert-right
(lambda ()
(erc-timestamp--display-margin-mode +1)
(ert-info ("margin, normal")
(let ((erc-timestamp-use-align-to 'margin))
(let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
(put-text-property 0 (length msg) 'wrap-prefix 10 msg)
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Space not added (treated as opaque string).
(should (search-forward "msg one [" nil t))
;; Field covers stamp alone
(should (eql ?e (char-before (field-beginning (point)))))
;; Vanity props extended
(should (get-text-property (field-beginning (point)) 'wrap-prefix))
(should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
(should (get-text-property (1- (field-end (point))) 'wrap-prefix))
(should (eql ?\n (char-after (field-end (point))))))
(ert-info ("margin, overlong (hard wrap)")
(let ((erc-timestamp-use-align-to 'margin)
(erc-timestamp-right-column 20))
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; No hard wrap
(should (search-forward "oooo [" nil t))
;; Field starts at leading space.
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;;; erc-stamp-tests.el ends here
|