aboutsummaryrefslogtreecommitdiffstats
path: root/test/lisp/textmodes/ispell-tests/ispell-tests-common.el
blob: 8111b39f30468e0dc9f478b1d77e32ba5cb48b1d (plain) (blame)
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
;;; ispell-tests-common.el --- Shared procedures for ispell tests.  -*- lexical-binding: t; -*-

;; Copyright (C) 2025 Lockywolf

;; Author: Lockywolf <for_emacs_1@lockywolf.net>
;; Keywords: languages, text

;; This program 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.

;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Shared procedures used by most ispell test files.

;;; Code:

(require 'ert)
(require 'ert-x)

(defvar ispell-tests--data-directory
  (let ((ert-resource-directory-trim-right-regexp "-tests/.*-tests-common\\.el"))
    (ert-resource-directory))
  "Resource directory for ispell tests.")

(defvar fake-aspell-path
  (expand-file-name "fake-aspell-new.bash" ispell-tests--data-directory)
  "Path to the mock backend.")


(let* ((backend-binaries (list "ispell" "aspell"  "hunspell"  "enchant-2" fake-aspell-path))
       (filter-binaries (seq-filter
                         (lambda (b)
                           (and
                            (executable-find b)
                            (equal 0
                                   (with-temp-buffer
                                     (call-process b nil t nil "-a")))))
                         backend-binaries)))

  (defun ispell-tests--some-backend-available-p ()
    "Return t if some spellchecking backend is available. "
    (not
     (null filter-binaries)))

  (defun ispell-tests--some-backend ()
    "Return the string of some available backend."
    (let ((retval (car filter-binaries)))
      (message "available backend is:%s" retval)
      retval)))

(defun ispell-tests--some-valid-dictionary (backend)
  "Return some dictionary name working for BACKEND."
  (cond ((string-equal backend "ispell")
         (with-temp-buffer
           (call-process backend nil t nil "-vv")
           (let* ((s "LIBDIR = ")
                  (slen (length s))
                  (_ (search-backward s))
                  (b (+ (point) slen 1))
                  (e (- (line-end-position) 1))
                  (ldir (buffer-substring b e))
                  (d (file-name-sans-extension
                      (file-name-nondirectory
                       (car (directory-files ldir t "\\.aff\\'"))))))
             d)))
        ((string-equal backend "aspell")
         (with-temp-buffer
           (call-process backend nil t nil "dump" "dicts")
           (goto-char 1)
           (buffer-substring 1 (line-end-position))))
        ((string-equal backend "hunspell")
         (with-temp-buffer
           (call-process backend nil t nil "-D")
           (search-backward "AVAILABLE DICTIONARIES" nil t)
           (forward-line 1)
           (let* ((s (buffer-substring (point) (line-end-position))))
             (file-name-sans-extension
              (file-name-nondirectory s)))))
        (t "english")))

(eval-when-compile
  (require 'cl-macs))
(cl-defmacro ispell-tests--letopt (bindings &body body)
  "Bind BINDINGS with `setopt', then eval BODY.
The value of the last form in BODY is returned.
Each element of VARLIST is a list (SYMBOL VALUEFORM)
\(which binds SYMBOL to the value of VALUEFORM with `setopt').
This macro is not expected to be used outside of
ispell-tests.  As `setopt' is naturally mutative,
the environment after the end of the form is not
guaranteed to be identical to the one before.  But the form
tries its best."
  (declare (indent 1) (debug cl-letf))
  (let* ((binding-var (lambda (binding) (car binding)))
	 (binding-val (lambda (binding) (cadr binding)))
	 (make-setopt
          (lambda (a b)
	    (list 'setopt a b)))
         (add-ignore-errors
          (lambda (a)
            (list 'ignore-errors a)))
	 (vars (seq-map binding-var bindings))
	 (values (seq-map binding-val bindings))
	 (temp-vars (seq-map #'gensym vars))
	 (savebindings (seq-mapn #'list temp-vars vars))
	 (tempbindings (seq-mapn make-setopt vars values))
	 (restorebindings (seq-mapn add-ignore-errors (seq-mapn make-setopt vars temp-vars))))
    `(let ,savebindings
       (unwind-protect (progn ,@tempbindings
			      ,@body)
	 ,@(reverse restorebindings)))))

(cl-defmacro ispell-tests--with-ispell-global-dictionary (ldict &body body)
  "Temporarily bind `ispell-global-dictionary' to value of LDICT, then eval BODY.
Then attempt to restore the original value of
`ispell-global-dictionary', which may fail, but this form tries
its best."
  (declare (indent 1) (debug t))
  (let* ((dictionary-val ldict)
	 (temp-var (gensym 'old-dictionary)))
    `(let ((,temp-var (symbol-value 'ispell-dictionary)))
       (unwind-protect (progn (ispell-change-dictionary ,dictionary-val t)
			      ,@body)
         (ignore-errors (ispell-change-dictionary ,temp-var))))))

(defconst ispell-tests--constants/english/correct-list
  '("hello" "test" "test" "more" "obvious" "word"))
(defconst ispell-tests--constants/english/correct-one "hello")
(defconst ispell-tests--constants/english/wrong "hellooooooo")
(defconst ispell-tests--constants/russian/correct "привет")
(defconst ispell-tests--constants/russian/wrong "ыфаывфафыввпфыв")
(defconst ispell-tests--constants/completion "waveguides")
(defconst ispell-tests--constants/nonexistent-dictionary "2110001888290146229")

(provide 'ispell-tests-common)

;;; ispell-tests-common.el ends here