;;; 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