1;;; syntax-tests.el --- tests for syntax.c functions -*- lexical-binding: t -*-
2
3;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
19
20;;; Code:
21
22(require 'ert)
23(require 'ert-x)
24(require 'cl-lib)
25
26(ert-deftest parse-partial-sexp-continue-over-comment-marker ()
27  "Continue a parse that stopped in the middle of a comment marker."
28  (with-temp-buffer
29    (let ((table (make-syntax-table)))
30      (modify-syntax-entry ?/ ". 124")
31      (modify-syntax-entry ?* ". 23b")
32      (set-syntax-table table))
33    (insert "/*C*/\nX")
34    (goto-char (point-min))
35    (let* ((pointC (progn (search-forward "C") (1- (point))))
36           (preC (1- pointC))
37           (pointX (progn (search-forward "X") (1- (point))))
38           (aftC (+ 2 pointC))
39           (ppsC (parse-partial-sexp (point-min) pointC))
40           (pps-preC (parse-partial-sexp (point-min) preC))
41           (pps-aftC (parse-partial-sexp (point-min) aftC))
42           (ppsX (parse-partial-sexp (point-min) pointX)))
43      ;; C should be inside comment.
44      (should (= (nth 0 ppsC) 0))
45      (should (eq (nth 4 ppsC) t))
46      (should (= (nth 8 ppsC) (- pointC 2)))
47      ;; X should not be in comment or list.
48      (should (= (nth 0 ppsX) 0))
49      (should-not (nth 4 ppsX))
50      ;; Try using OLDSTATE.
51      (should (equal (parse-partial-sexp preC pointC nil nil pps-preC)
52                     ppsC))
53      (should (equal (parse-partial-sexp pointC aftC nil nil ppsC)
54                     pps-aftC))
55      (should (equal (parse-partial-sexp preC aftC nil nil pps-preC)
56                     pps-aftC))
57      (should (equal (parse-partial-sexp aftC pointX nil nil pps-aftC)
58                     ppsX)))))
59
60(ert-deftest syntax-class-character-test ()
61  (cl-loop for char across " .w_()'\"$\\/<>@!|"
62           for i from 0
63           do (should (= char (syntax-class-to-char i)))
64           when (string-to-syntax (string char))
65           do (should (= char (syntax-class-to-char
66                               (car (string-to-syntax (string char)))))))
67  (should-error (syntax-class-to-char -1))
68  (should-error (syntax-class-to-char 200)))
69
70(ert-deftest parse-partial-sexp-paren-comments ()
71  "Test syntax parsing with paren comment markers.
72Specifically, where the first character of the comment marker is
73also has open paren syntax (see Bug#24870)."
74  (with-temp-buffer
75    (let ((table (make-syntax-table)))
76      (modify-syntax-entry ?\{  "(}1nb" table)
77      (modify-syntax-entry ?\}  "){4nb" table)
78      (modify-syntax-entry ?-  ". 123" table)
79      (set-syntax-table table))
80    (insert "{-C-}\nX")
81    (goto-char (point-min))
82    (let* ((pointC (progn (search-forward "C") (1- (point))))
83           (pointX (progn (search-forward "X") (1- (point))))
84           (ppsC (parse-partial-sexp (point-min) pointC))
85           (ppsX (parse-partial-sexp (point-min) pointX)))
86      ;; C should be inside nestable comment, not list.
87      (should (= (nth 0 ppsC) 0))
88      (should (= (nth 4 ppsC) 1))
89      (should (= (nth 8 ppsC) (- pointC 2)))
90      ;; X should not be in comment or list.
91      (should (= (nth 0 ppsX) 0))
92      (should-not (nth 4 ppsX))
93      ;; Try using OLDSTATE.
94      (should (equal (parse-partial-sexp pointC pointX nil nil ppsC)
95                     ppsX)))))
96
97
98;;; Commentary:
99;; The next bit tests the handling of comments in syntax.c, in
100;; particular the functions `forward-comment' and `scan-lists' and
101;; `parse-partial-sexp' (in so far as they relate to comments).
102
103;; It is intended to enhance this bit to test nested comments
104;; (2020-10-01).
105
106;; This bit uses the data file syntax-resources/syntax-comments.txt.
107
108(defun syntax-comments-point (n forw)
109  "Return the buffer offset corresponding to the \"label\" N.
110N is a decimal number which appears in the data file, usually
111twice, as \"labels\".  It can also be a negative number or zero.
112FORW is t when we're using the label at BOL, nil for the one at EOL.
113
114If the label N doesn't exist in the current buffer, an exception
115is thrown.
116
117When FORW is t and N positive, we return the position after the
118first occurrence of label N at BOL in the data file.  With FORW
119nil, we return the position before the last occurrence of the
120label at EOL in the data file.
121
122When N is negative, we return instead the position of the end of
123line that the -N label is on.  When it is zero, we return POINT."
124  (if (zerop n)
125      (point)
126    (let ((str (format "%d" (abs n))))
127      (save-excursion
128	(if forw
129	    (progn
130	      (goto-char (point-min))
131	      (re-search-forward
132	       (concat "^\\(" str "\\)\\([^0-9\n]\\|$\\)"))
133	      (if (< n 0)
134		  (progn (end-of-line) (point))
135		(match-end 1)))
136	  (goto-char (point-max))
137	  (re-search-backward
138	   (concat "\\(^\\|[^0-9]\\)\\(" str "\\)$"))
139	  (if (< n 0)
140	      (progn (end-of-line) (point))
141	    (match-beginning 2)))))))
142
143(defun syntax-comments-midpoint (n)
144  "Return the buffer offset corresponding to the \"label\" N.
145N is a positive decimal number which should appear in the buffer
146exactly once.  The label need not be at the beginning or end of a
147line.
148
149The return value is the position just before the label.
150
151If the label N doesn't exist in the current buffer, an exception
152is thrown."
153  (let ((str (format "%d" n)))
154    (save-excursion
155      (goto-char (point-min))
156      (re-search-forward
157       (concat "\\(^\\|[^0-9]\\)\\(" str "\\)\\([^0-9\n]\\|$\\)"))
158      (match-beginning 2))))
159
160(eval-and-compile
161  (defvar syntax-comments-section))
162
163(defmacro syntax-comments (-type- -dir- res start &optional stop)
164  "Create an ERT test to test (forward-comment 1/-1).
165The test uses a fixed name data file, which it visits.  It calls
166entry and exit functions to set up and tear down syntax entries
167for comment characters.  The test is given a name based on the
168global variable `syntax-comments-section', the direction of
169movement and the value of START.
170
171-TYPE- (unquoted) is a symbol from whose name the entry and exit
172function names are derived by appending \"-in\" and \"-out\".
173
174-DIR- (unquoted) is `forward' or `backward', the direction
175`forward-comment' is attempted.
176
177RES, t or nil, is the expected result from `forward-comment'.
178
179START and STOP are decimal numbers corresponding to labels in the
180data file marking the start and expected stop positions.  See
181`syntax-comments-point' for a precise specification.  If STOP is
182missing or nil, the value of START is assumed for it."
183  (declare (debug t))
184  (let ((forw
185	 (cond
186	  ((eq -dir- 'forward) t)
187	  ((eq -dir- 'backward) nil)
188	  (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-))))
189	(start-str (format "%d" (abs start)))
190	(type -type-))
191    `(ert-deftest ,(intern (concat "syntax-comments-"
192				   syntax-comments-section
193				   (if forw "-f" "-b") start-str))
194	 ()
195       (with-current-buffer
196	   (find-file
197            ,(ert-resource-file "syntax-comments.txt"))
198	 (,(intern (concat (symbol-name type) "-in")))
199	 (goto-char (syntax-comments-point ,start ,forw))
200	 (let ((stop (syntax-comments-point ,(or stop start) ,(not forw))))
201	   (should (eq (forward-comment ,(if forw 1 -1)) ,res))
202	   (should (eq (point) stop)))
203	 (,(intern (concat (symbol-name type) "-out")))))))
204
205(defmacro syntax-br-comments (-type- -dir- res -start- &optional stop)
206  "Create an ERT test to test (scan-lists <position> 1/-1 0).
207This is to test the interface between scan-lists and the internal
208comment routines in syntax.c.
209
210The test uses a fixed name data file, which it visits.  It calls
211entry and exit functions to set up and tear down syntax entries
212for comment and paren characters.  The test is given a name based
213on the global variable `syntax-comments-section', the direction
214of movement and the value of -START-.
215
216-TYPE- (unquoted) is a symbol from whose name the entry and exit
217function names are derived by appending \"-in\" and \"-out\".
218
219-DIR- (unquoted) is `forward' or `backward', the direction
220`scan-lists' is attempted.
221
222RES is t if `scan-lists' is expected to return, nil if it is
223expected to raise a `scan-error' exception.
224
225-START- and STOP are decimal numbers corresponding to labels in the
226data file marking the start and expected stop positions.  See
227`syntax-comments-point' for a precise specification.  If STOP is
228missing or nil, the value of -START- is assumed for it."
229  (declare (debug t))
230  (let* ((forw
231	  (cond
232	   ((eq -dir- 'forward) t)
233	   ((eq -dir- 'backward) nil)
234	   (t (error "Invalid -dir- argument \"%s\" to `syntax-br-comments'" -dir-))))
235         (start -start-)
236	 (start-str (format "%d" (abs start)))
237	 (type -type-))
238    `(ert-deftest ,(intern (concat "syntax-br-comments-"
239				   syntax-comments-section
240				   (if forw "-f" "-b") start-str))
241	 ()
242       (with-current-buffer
243	   (find-file
244            ,(ert-resource-file "syntax-comments.txt"))
245	 (,(intern (concat (symbol-name type) "-in")))
246         (let ((start-pos (syntax-comments-point ,start ,forw))
247               ,@(if res
248                     `((stop-pos (syntax-comments-point
249                                  ,(or stop start) ,(not forw))))))
250           ,(if res
251                `(should
252                  (eq (scan-lists start-pos ,(if forw 1 -1) 0)
253                      stop-pos))
254              `(should-error (scan-lists start-pos ,(if forw 1 -1) 0)
255                             :type 'scan-error)))
256	 (,(intern (concat (symbol-name type) "-out")))))))
257
258(defmacro syntax-pps-comments (-type- -start- open close &optional -stop-)
259  "Create an ERT test to test `parse-partial-sexp' with comments.
260This is to test the interface between `parse-partial-sexp' and
261the internal comment routines in syntax.c.
262
263The test uses a fixed name data file, which it visits.  It calls
264entry and exit functions to set up and tear down syntax entries
265for comment and paren characters.  The test is given a name based
266on the global variable `syntax-comments-section', and the value
267of -START-.
268
269The generated test calls `parse-partial-sexp' three times, the
270first two with COMMENTSTOP set to `syntax-table' so as to stop
271after the start and end of the comment.  The third call is
272expected to stop at the brace/paren matching the one where the
273test started.
274
275-TYPE- (unquoted) is a symbol from whose name the entry and exit
276function names are derived by appending \"-in\" and \"-out\".
277
278-START- and -STOP- are decimal numbers corresponding to labels in
279the data file marking the start and expected stop positions.  See
280`syntax-comments-point' for a precise specification.  If -STOP-
281is missing or nil, the value of -START- is assumed for it.
282
283OPEN and CLOSE are decimal numbers corresponding to labels in the
284data file marking just after the comment opener and closer where
285the `parse-partial-sexp's are expected to stop.  See
286`syntax-comments-midpoint' for a precise specification."
287  (declare (debug t))
288  (let* ((type -type-)
289         (start -start-)
290         (start-str (format "%d" start))
291         (stop (or -stop- start)))
292    `(ert-deftest ,(intern (concat "syntax-pps-comments-"
293                                   syntax-comments-section
294                                   "-" start-str))
295         ()
296       (with-current-buffer
297           (find-file
298            ,(ert-resource-file "syntax-comments.txt"))
299         (,(intern (concat (symbol-name type) "-in")))
300         (let ((start-pos (syntax-comments-point ,start t))
301               (open-pos (syntax-comments-midpoint ,open))
302               (close-pos (syntax-comments-midpoint ,close))
303               (stop-pos (syntax-comments-point ,stop nil))
304               s)
305           (setq s (parse-partial-sexp
306                    start-pos (point-max) 0 nil nil 'syntax-table))
307           (should (eq (point) open-pos))
308           (setq s (parse-partial-sexp
309                    (point) (point-max) 0 nil s 'syntax-table))
310           (should (eq (point) close-pos))
311           (setq s (parse-partial-sexp (point) (point-max) 0 nil s))
312           (should (eq (point) stop-pos)))
313         (,(intern (concat (symbol-name type) "-out")))))))
314
315;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
316;; "Pascal" style comments - single character delimiters, the closing
317;; delimiter not being newline.
318;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
319(defun {-in ()
320  (setq parse-sexp-ignore-comments t)
321  (setq comment-end-can-be-escaped nil)
322  (modify-syntax-entry ?{ "<")
323  (modify-syntax-entry ?} ">"))
324(defun {-out ()
325  (modify-syntax-entry ?{ "(}")
326  (modify-syntax-entry ?} "){"))
327(eval-and-compile
328  (setq syntax-comments-section "pascal"))
329
330(syntax-comments { forward nil 20 0)
331(syntax-comments { backward nil 20 0)
332(syntax-comments { forward t 21)
333(syntax-comments { backward t 21)
334(syntax-comments { forward t 22)
335(syntax-comments { backward t 22)
336
337(syntax-comments { forward t 23)
338(syntax-comments { backward t 23)
339(syntax-comments { forward t 24)
340(syntax-comments { backward t 24)
341(syntax-comments { forward t 26)
342(syntax-comments { backward t 26)
343
344;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
345;; "Lisp" style comments - single character opening delimiters on line
346;; comments.
347;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
348(defun \;-in ()
349  (setq parse-sexp-ignore-comments t)
350  (setq comment-end-can-be-escaped nil)
351  (modify-syntax-entry ?\n ">")
352  (modify-syntax-entry ?\; "<")
353  (modify-syntax-entry ?{ ".")
354  (modify-syntax-entry ?} "."))
355(defun \;-out ()
356  (modify-syntax-entry ?\n " ")
357  (modify-syntax-entry ?\; ".")
358  (modify-syntax-entry ?{ "(}")
359  (modify-syntax-entry ?} "){"))
360(eval-and-compile
361  (setq syntax-comments-section "lisp"))
362
363(syntax-comments \; backward nil 30 30)
364(syntax-comments \; forward t 31)
365(syntax-comments \; backward t 31)
366(syntax-comments \; forward t 32)
367(syntax-comments \; backward t 32)
368(syntax-comments \; forward t 33)
369(syntax-comments \; backward t 33)
370
371;; "Lisp" style comments inside lists.
372(syntax-br-comments \; backward nil 40)
373(syntax-br-comments \; forward t 41)
374(syntax-br-comments \; backward t 41)
375(syntax-br-comments \; forward t 42)
376(syntax-br-comments \; backward t 42)
377(syntax-br-comments \; forward nil 43)
378
379;; "Lisp" style comments parsed by `parse-partial-sexp'.
380(syntax-pps-comments \; 41 90 91)
381(syntax-pps-comments \; 42 92 93)
382(syntax-pps-comments \; 43 94 95 -999)
383
384;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
385;; "Lisp" style nested comments: between delimiters #|  |#.
386;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
387(defun \#|-in ()
388  (setq parse-sexp-ignore-comments t)
389  (modify-syntax-entry ?# ". 14")
390  (modify-syntax-entry ?| ". 23n")
391  (modify-syntax-entry ?\; "< b")
392  (modify-syntax-entry ?\n "> b"))
393(defun \#|-out ()
394  (modify-syntax-entry ?# ".")
395  (modify-syntax-entry ?| ".")
396  (modify-syntax-entry ?\; ".")
397  (modify-syntax-entry ?\n " "))
398(eval-and-compile
399  (setq syntax-comments-section "lisp-n"))
400
401(syntax-comments \#| forward nil 100 0)
402(syntax-comments \#| backward nil 100 0)
403(syntax-comments \#| forward nil 101 -999)
404(syntax-comments \#| forward t 102)
405(syntax-comments \#| backward t 102)
406
407(syntax-comments \#| forward t 103)
408(syntax-comments \#| backward t 103)
409(syntax-comments \#| forward t 104)
410(syntax-comments \#| backward t 104)
411
412(syntax-comments \#| forward nil 105 -999)
413(syntax-comments \#| backward t 105)
414(syntax-comments \#| forward t 106)
415(syntax-comments \#| backward t 106)
416(syntax-comments \#| forward t 107)
417(syntax-comments \#| backward t 107)
418
419;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
420;; Mixed "Lisp" style (nested and unnested) comments.
421;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
422(syntax-comments \#| forward t 110)
423(syntax-comments \#| backward t 110)
424(syntax-comments \#| forward t 111)
425(syntax-comments \#| backward t 111)
426
427;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil.
429;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
430(defun /*-in ()
431  (setq parse-sexp-ignore-comments t)
432  (setq comment-end-can-be-escaped t)
433  (modify-syntax-entry ?/ ". 124b")
434  (modify-syntax-entry ?* ". 23")
435  (modify-syntax-entry ?\n "> b"))
436(defun /*-out ()
437  (setq comment-end-can-be-escaped nil)
438  (modify-syntax-entry ?/ ".")
439  (modify-syntax-entry ?* ".")
440  (modify-syntax-entry ?\n " "))
441(eval-and-compile
442  (setq syntax-comments-section "c"))
443
444(syntax-comments /* forward t 1)
445(syntax-comments /* backward t 1)
446(syntax-comments /* forward t 2)
447(syntax-comments /* backward t 2)
448(syntax-comments /* forward t 3)
449(syntax-comments /* backward t 3)
450
451(syntax-comments /* forward t 4)
452(syntax-comments /* backward t 4)
453(syntax-comments /* forward t 5 6)
454(syntax-comments /* backward nil 5 0)
455(syntax-comments /* forward nil 6 0)
456(syntax-comments /* backward t 6 5)
457
458(syntax-comments /* forward t 7 8)
459(syntax-comments /* backward nil 7 0)
460(syntax-comments /* forward nil 8 0)
461(syntax-comments /* backward t 8 7)
462(syntax-comments /* forward t 9)
463(syntax-comments /* backward t 9)
464
465(syntax-comments /* forward nil 10 0)
466(syntax-comments /* backward nil 10 0)
467(syntax-comments /* forward t 11)
468(syntax-comments /* backward t 11)
469
470(syntax-comments /* forward t 13 14)
471(syntax-comments /* backward nil 13 -14)
472(syntax-comments /* forward t 15)
473(syntax-comments /* backward t 15)
474
475;; Emacs 27 "C" style comments inside brace lists.
476(syntax-br-comments /* forward t 50)
477(syntax-br-comments /* backward t 50)
478(syntax-br-comments /* forward t 51)
479(syntax-br-comments /* backward t 51)
480(syntax-br-comments /* forward t 52)
481(syntax-br-comments /* backward t 52)
482
483(syntax-br-comments /* forward t 53)
484(syntax-br-comments /* backward t 53)
485(syntax-br-comments /* forward t 54 20)
486(syntax-br-comments /* backward t 54)
487(syntax-br-comments /* forward t 55)
488(syntax-br-comments /* backward t 55)
489
490(syntax-br-comments /* forward t 56 58)
491(syntax-br-comments /* backward t 58 56)
492(syntax-br-comments /* backward nil 59)
493(syntax-br-comments /* forward t 60)
494(syntax-br-comments /* backward t 60)
495
496;; Emacs 27 "C" style comments parsed by `parse-partial-sexp'.
497(syntax-pps-comments /* 50 70 71)
498(syntax-pps-comments /* 52 72 73)
499(syntax-pps-comments /* 54 74 55 20)
500(syntax-pps-comments /* 56 76 77 58)
501(syntax-pps-comments /* 60 78 79)
502
503(ert-deftest test-from-to-parse-partial-sexp ()
504  (with-temp-buffer
505    (insert "foo")
506    (should (parse-partial-sexp 1 1))
507    (should-error (parse-partial-sexp 2 1))))
508
509;;; syntax-tests.el ends here
510