Skip to content

Commit 4c4dbd8

Browse files
tmcgilchristtmcgilchrist
committed
Move ert tests into separate file and run tests in CI.
Replace pos-eol from Emacs 29 with older line-end-position function that exists in Emacs 28 and older.
1 parent 671ef62 commit 4c4dbd8

File tree

4 files changed

+288
-233
lines changed

4 files changed

+288
-233
lines changed

‎.github/workflows/emacs-lint.yml‎

Lines changed: 27 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -15,20 +15,40 @@ jobs:
1515
runs-on: ubuntu-latest
1616
strategy:
1717
matrix:
18+
os:
19+
- ubuntu-latest
20+
ocaml-compiler:
21+
- 5.2.x
1822
emacs_version:
1923
- '27.2'
2024
- '28.2'
21-
- '29.1'
25+
- '29.3'
2226
- snapshot
2327
fail-fast: false # don't stop jobs if one fails
2428
env:
2529
EMACS_PACKAGE_LINT_IGNORE: ${{ matrix.package_lint_ignore }}
2630
EMACS_BYTECOMP_WARN_IGNORE: ${{ matrix.bytecomp_warn_ignore }}
2731
steps:
28-
- uses: purcell/setup-emacs@v6.0
29-
with:
30-
version: ${{ matrix.emacs_version }}
32+
- uses: purcell/setup-emacs@v6.0
33+
with:
34+
version: ${{ matrix.emacs_version }}
3135

32-
- uses: actions/checkout@v4
33-
- name: Run tests
34-
run: 'cd emacs && ./check.sh'
36+
- uses: actions/checkout@v4
37+
38+
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
39+
uses: ocaml/setup-ocaml@v3
40+
with:
41+
ocaml-compiler: ${{ matrix.ocaml-compiler }}
42+
43+
- name: Install dependencies
44+
run: |
45+
opam pin menhirLib 20201216 --no-action
46+
opam install --yes ppx_string ppx_compare
47+
opam install . --deps-only --with-test --yes
48+
49+
- name: Build and install
50+
run: |
51+
opam install . --yes
52+
53+
- name: Run tests
54+
run: 'cd emacs && opam exec -- ./check.sh'

‎emacs/check.sh‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ NEEDED_PACKAGES="package-lint company iedit auto-complete"
88
ELS_TO_CHECK=*.el
99
# To reduce the amount of false positives we only package-lint files
1010
# that are actual installable packages.
11-
PKGS_TO_CHECK="merlin.el merlin-ac.el merlin-company.el merlin-iedit.el"
11+
PKGS_TO_CHECK="merlin.el merlin-ac.el merlin-company.el merlin-iedit.el merlin-cap.el"
1212

1313
INIT_PACKAGE_EL="(progn \
1414
(require 'package) \
@@ -50,3 +50,11 @@ EMACS_PACKAGE_LINT_IGNORE=1
5050
--eval "(require 'package-lint)" \
5151
-f package-lint-batch-and-exit \
5252
${PKGS_TO_CHECK} || [ -n "${EMACS_PACKAGE_LINT_IGNORE:+x}" ]
53+
54+
# Run tests in batch mode.
55+
"$EMACS" -Q -batch \
56+
--eval "$INIT_PACKAGE_EL" \
57+
-L . \
58+
--eval "(progn\
59+
(load-file \"merlin-cap-test.el\")\
60+
(ert-run-tests-batch-and-exit))"

‎emacs/merlin-cap-test.el‎

Lines changed: 251 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,251 @@
1+
;;; merlin-cap.el --- Merlin and completion-at-point integration -*- coding: utf-8; lexical-binding: t -*-
2+
;; Licensed under the MIT license.
3+
4+
;; Author: Simon Castellan <simon.castellan(_)iuwt.fr>
5+
;; Frédéric Bour <frederic.bour(_)lakaban.net>
6+
;; Thomas Refis <thomas.refis(_)gmail.com>
7+
;; Tim McGilchrist <timmcgil@gmail.com>
8+
;; Created: 13 Sep 2024
9+
;; Version: 0.1
10+
;; Keywords: ocaml languages
11+
;; URL: http://github.com/ocaml/merlin
12+
13+
;;; Commentary:
14+
15+
;; Run tests for merlin-completion-at-point code.
16+
17+
;;; Code:
18+
19+
(require 'merlin)
20+
(require 'ert)
21+
22+
(ert-deftest test-merlin-cap--bounds ()
23+
(should (equal (merlin-cap--regions "Aaa.bbb.c" "cc.ddd")
24+
'("Aaa.bbb." "Aaa.bbb." "ccc." "ddd")))
25+
(should (equal (merlin-cap--regions "~fo" "o.bar")
26+
'("" "" "~foo" "")))
27+
(should (equal (merlin-cap--regions "" "~foo.bar")
28+
'("" "" "~foo" "")))
29+
(should (equal (merlin-cap--regions "~fo" "o~bar")
30+
'("" "" "~foo" "")))
31+
(should (equal (merlin-cap--regions "~foo" "~bar")
32+
'("" "" "~foo" "")))
33+
(should (equal (merlin-cap--regions "~fo" "o.b~ar")
34+
'("" "" "~foo" "")))
35+
;; There's no obvious correct thing to return in this case, so this is fine.
36+
(should (equal (merlin-cap--regions "~foo.bar" "")
37+
'("foo." "foo." "bar" "")))
38+
(should (equal (merlin-cap--regions "" "~")
39+
'("" "" "~" "")))
40+
(should (equal (merlin-cap--regions "" "Aaa.bbb.ccc.ddd")
41+
'("" "" "Aaa." "bbb.ccc.ddd")))
42+
(should (equal (merlin-cap--regions "A" "aa.bbb.ccc.ddd")
43+
'("" "" "Aaa." "bbb.ccc.ddd")))
44+
;; An "atom" can also just be a dotted path projecting from an expression
45+
(should (equal (merlin-cap--regions "(foo bar)." "")
46+
'("." "." "" "")))
47+
(should (equal (merlin-cap--regions "(foo bar).Aa" "a")
48+
'("." "." "Aaa" "")))
49+
(should (equal (merlin-cap--regions "(foo bar).Aaa.Bb" "b.ccc")
50+
'("." ".Aaa." "Bbb." "ccc")))
51+
(should (equal (merlin-cap--regions "(foo bar).Aaa.bb" "b.ccc")
52+
'("." ".Aaa." "bbb." "ccc")))
53+
(should (equal (merlin-cap--regions "(foo bar).aaa.bb" "b.ccc")
54+
'(".aaa." ".aaa." "bbb." "ccc")))
55+
;; We should omit only uppercase components before point, not lowercase ones
56+
(should (equal (merlin-cap--regions "M." "x")
57+
'("" "M." "x" "")))
58+
(should (equal (merlin-cap--regions "M.t." "x")
59+
'("M.t." "M.t." "x" "")))
60+
(should (equal (merlin-cap--regions "M.N." "x")
61+
'("" "M.N." "x" "")))
62+
(should (equal (merlin-cap--regions "M.t.N." "x")
63+
'("M.t." "M.t.N." "x" "")))
64+
(should (equal (merlin-cap--regions "aa.bB.CC.x" "")
65+
'("aa.bB." "aa.bB.CC." "x" "")))
66+
(should (equal (merlin-cap--regions "Aa.bB.CC.x" "")
67+
'("Aa.bB." "Aa.bB.CC." "x" "")))
68+
(should (equal (merlin-cap--regions "aa.Bb.cc.x" "")
69+
'("aa.Bb.cc." "aa.Bb.cc." "x" "")))
70+
(should (equal (merlin-cap--regions "aa.Bb.Cc.x" "")
71+
'("aa." "aa.Bb.Cc." "x" ""))))
72+
73+
(defvar-local messages-buffer-name "*Messages*")
74+
75+
(defun merlin-cap--current-message ()
76+
"Like `current-message' but work in batch mode and use `messages-buffer-name'."
77+
(with-current-buffer messages-buffer-name
78+
(save-excursion
79+
(forward-line -1)
80+
(buffer-substring (point) (line-end-position)))))
81+
82+
(defmacro merlin-cap--with-test-buffer (&rest body)
83+
"Run BODY with a temp buffer set up for Merlin completion."
84+
`(with-temp-buffer
85+
(merlin-mode)
86+
(setq-local completion-at-point-functions '(merlin-cap))
87+
(insert "
88+
module Mmaa = struct
89+
module Mmbb = struct
90+
type ttaa = { ffaa : int }
91+
type ttbb = { ffbb : ttaa }
92+
let (vvaa : ttbb) = { ffbb = { ffaa = 0 } }
93+
;;
94+
end
95+
end
96+
97+
let () = ")
98+
;; Don't log during the tests
99+
(let ((merlin-client-log-function nil))
100+
,@body)))
101+
102+
(defun merlin-cap--test-complete (prefix suffix new-prefix new-suffix message)
103+
"Trigger completion with point between PREFIX and SUFFIX and compare results.
104+
105+
NEW-PREFIX and NEW-SUFFIX are what's before and after point after
106+
completion, and MESSAGE is the message printed."
107+
(let ((start (point)))
108+
(insert prefix)
109+
(save-excursion (insert suffix))
110+
;; clear any previous message, to avoid coalescing [no message]
111+
(message "\n")
112+
(message "[no message]")
113+
(completion-at-point)
114+
(let ((end (line-end-position))
115+
;; Just so the ERT error renders more nicely
116+
(point (point)))
117+
(should (equal (list (buffer-substring start point)
118+
(buffer-substring point end)
119+
(merlin-cap--current-message))
120+
(list new-prefix new-suffix message))))
121+
(delete-region start (line-end-position))))
122+
123+
(ert-deftest test-merlin-cap-completion ()
124+
(with-temp-buffer
125+
(let ((messages-buffer-name (buffer-name (current-buffer))))
126+
(merlin-cap--with-test-buffer
127+
(let ((merlin-cap-dot-after-module nil))
128+
(merlin-cap--test-complete "Mma" ""
129+
"Mmaa" ""
130+
"Mmaa: <module>")
131+
(merlin-cap--test-complete "Mmaa.Mmb" ""
132+
"Mmaa.Mmbb" ""
133+
"Mmaa.Mmbb: <module>")
134+
(merlin-cap--test-complete "Mmaa.Mmbb.vva" ""
135+
"Mmaa.Mmbb.vvaa" ""
136+
"Mmaa.Mmbb.vvaa: Mmaa.Mmbb.ttbb"))
137+
;; Manually clear the cache, since the differences produced by
138+
;; `merlin-cap-dot-after-module' are persisted in the cache.
139+
(setq-local merlin-cap--cache nil)
140+
(let ((merlin-cap-dot-after-module t))
141+
(merlin-cap--test-complete "Mma" ""
142+
"Mmaa." ""
143+
"[no message]")
144+
(merlin-cap--test-complete "Mmaa.Mmb" ""
145+
"Mmaa.Mmbb." ""
146+
"[no message]")
147+
(merlin-cap--test-complete "Mmaa.Mmbb.vva" ""
148+
"Mmaa.Mmbb.vvaa" ""
149+
"Mmaa.Mmbb.vvaa: Mmaa.Mmbb.ttbb")
150+
(should (equal (length merlin-cap--cache) 3))
151+
(merlin-cap--test-complete "Mmaa.Mmbb.vvaa.ff" ""
152+
"Mmaa.Mmbb.vvaa.ffbb" ""
153+
"Mmaa.Mmbb.vvaa.ffbb: Mmaa.Mmbb.ttbb -> Mmaa.Mmbb.ttaa")
154+
;; When completing inside a record we have to include the record name in the
155+
;; buffer contents sent to Merlin; that invalidates the cache
156+
(should (equal (length merlin-cap--cache) 1))
157+
(merlin-cap--test-complete "Mmaa.Mmbb.vvaa.ffbb.ff" ""
158+
"Mmaa.Mmbb.vvaa.ffbb.ffaa" ""
159+
"Mmaa.Mmbb.vvaa.ffbb.ffaa: Mmaa.Mmbb.ttaa -> int")
160+
;; We're completing in a new part of the record, so again the cache is invalidated
161+
(should (equal (length merlin-cap--cache) 1))
162+
;; completion in the middle of the atom
163+
(merlin-cap--test-complete "Mmaa.Mmb" ".vva"
164+
"Mmaa.Mmbb." "vva"
165+
"[no message]")
166+
;; partial completion (PCM)
167+
(setq-local merlin-cap--cache nil)
168+
(merlin-cap--test-complete "Mma.Mmb.vva" ""
169+
"Mmaa.Mmbb.vvaa" ""
170+
"Mmaa.Mmbb.vvaa: Mmaa.Mmbb.ttbb")
171+
;; The cache entries appear in reverse order of PCM's lookups;
172+
;; first it looks up the existing string, removing a component from the end each time it finds no results;
173+
;; eventually PCM just has "Mma." and it queries for "" to find completions, and it finds "Mmaa.";
174+
;; from there it can query for "Mmaa." and "Mmaa.Mmbb." to find completions and expand each component.
175+
(should (equal (reverse (mapcar #'car merlin-cap--cache))
176+
'("Mma.Mmb." "Mma." "" "Mmaa." "Mmaa.Mmbb.")))
177+
;; partial completion with a glob
178+
(merlin-cap--test-complete "Mma.*.vva" ""
179+
"Mmaa.Mmbb.vvaa" ""
180+
"Mmaa.Mmbb.vvaa: Mmaa.Mmbb.ttbb")
181+
;; When PCM looks up "Mma.*." and gets no results, that's how it knows it is safe to glob instead.
182+
(should (member "Mma.*." (mapcar #'car merlin-cap--cache)))
183+
;; completion with no results
184+
(merlin-cap--test-complete "Mmaa.Mmbbxxx." ""
185+
"Mmaa.Mmbbxxx." ""
186+
"No match")
187+
;; The lack of results is cached.
188+
(should (equal (length merlin-cap--cache) 7))
189+
;; completion in and after a parenthesized expression
190+
(merlin-cap--test-complete "(Mmaa.Mmbb.vv" ""
191+
"(Mmaa.Mmbb.vvaa" ""
192+
"Mmaa.Mmbb.vvaa: Mmaa.Mmbb.ttbb")
193+
(merlin-cap--test-complete "(Mmaa.Mmbb.vvaa).ffb" ""
194+
"(Mmaa.Mmbb.vvaa).ffbb" ""
195+
".ffbb: Mmaa.Mmbb.ttbb -> Mmaa.Mmbb.ttaa")
196+
;; We're completing after a different expression, so no caching.
197+
(should (equal (length merlin-cap--cache) 1))
198+
(merlin-cap--test-complete "((fun x -> x) Mmaa.Mmbb.vvaa).ffbb.ffa" ""
199+
"((fun x -> x) Mmaa.Mmbb.vvaa).ffbb.ffaa" ""
200+
".ffbb.ffaa: Mmaa.Mmbb.ttaa -> int"))))))
201+
202+
(ert-deftest test-merlin-cap-interrupts ()
203+
"Test that `merlin-cap' is robust to being interrupted.
204+
205+
At least at some hardcoded interruption points."
206+
(merlin-cap--with-test-buffer
207+
(let (syms)
208+
;; Collect the interruption position symbols
209+
(cl-letf (((symbol-function 'merlin-cap--interrupt-in-test)
210+
(lambda (sym) (push sym syms))))
211+
(merlin-cap--get-completions ""))
212+
;; Make sure we're actually doing something
213+
(should (> (length syms) 3))
214+
;; For each position, interrupt at that position.
215+
(dolist (sym-to-interrupt syms)
216+
(let ((procs (process-list)))
217+
(let ((merlin-cap--interrupt-symbol sym-to-interrupt))
218+
;; Interrupt it a few times, in case there's only an error the
219+
;; second or third time.
220+
(should-error (merlin-cap--get-completions "Mmaa.")
221+
:type 'merlin-cap--test-interrupt)
222+
;; Also with a different prefix.
223+
(should-error (merlin-cap--get-completions "Non.existent.Thing.")
224+
:type 'merlin-cap--test-interrupt)
225+
(should-error (merlin-cap--get-completions "Mmaa.")
226+
:type 'merlin-cap--test-interrupt))
227+
(should (equal (merlin-cap--get-completions "Mmaa.") '("Mmbb.")))
228+
;; Remove the cache entry added by that presumably-successful completion.
229+
(setq merlin-cap--cache nil)
230+
;; All the created processes have been deleted
231+
(should (equal (cl-set-difference (process-list) procs) '())))))))
232+
233+
(ert-deftest test-merlin-cap-closed-pipe ()
234+
"Test the Merlin server is robust to an EPIPE caused by Emacs.
235+
236+
We delete the Merlin client process without sending all input,
237+
which causes the Merlin server to get EPIPE from all IO, which
238+
it's had bugs with before.
239+
240+
Reliably reproducing these errors may require increasing the
241+
count in `dotimes'."
242+
(merlin-cap--with-test-buffer
243+
(dotimes (_ 10)
244+
(dotimes (_ 3)
245+
(let ((merlin-cap--interrupt-symbol 'sent-half-input))
246+
(should-error (merlin-cap--get-completions "Mmaa.Mmbb.")
247+
:type 'merlin-cap--test-interrupt)))
248+
(should (equal (merlin-cap--get-completions "Mmaa.") '("Mmbb."))))))
249+
250+
(provide 'merlin-cap-test)
251+
;;; merlin-cap-test.el ends here

0 commit comments

Comments
 (0)