;;; syntax-tests.el --- tests for syntax.c functions -*- lexical-binding: t -*-

;; Copyright (C) 2017-2020 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/>.

;;; Code:

(require 'ert)

(ert-deftest parse-partial-sexp-continue-over-comment-marker ()
  "Continue a parse that stopped in the middle of a comment marker."
  (with-temp-buffer
    (let ((table (make-syntax-table)))
      (modify-syntax-entry ?/ ". 124")
      (modify-syntax-entry ?* ". 23b")
      (set-syntax-table table))
    (insert "/*C*/\nX")
    (goto-char (point-min))
    (let* ((pointC (progn (search-forward "C") (1- (point))))
           (preC (1- pointC))
           (pointX (progn (search-forward "X") (1- (point))))
           (aftC (+ 2 pointC))
           (ppsC (parse-partial-sexp (point-min) pointC))
           (pps-preC (parse-partial-sexp (point-min) preC))
           (pps-aftC (parse-partial-sexp (point-min) aftC))
           (ppsX (parse-partial-sexp (point-min) pointX)))
      ;; C should be inside comment.
      (should (= (nth 0 ppsC) 0))
      (should (eq (nth 4 ppsC) t))
      (should (= (nth 8 ppsC) (- pointC 2)))
      ;; X should not be in comment or list.
      (should (= (nth 0 ppsX) 0))
      (should-not (nth 4 ppsX))
      ;; Try using OLDSTATE.
      (should (equal (parse-partial-sexp preC pointC nil nil pps-preC)
                     ppsC))
      (should (equal (parse-partial-sexp pointC aftC nil nil ppsC)
                     pps-aftC))
      (should (equal (parse-partial-sexp preC aftC nil nil pps-preC)
                     pps-aftC))
      (should (equal (parse-partial-sexp aftC pointX nil nil pps-aftC)
                     ppsX)))))

(ert-deftest parse-partial-sexp-paren-comments ()
  "Test syntax parsing with paren comment markers.
Specifically, where the first character of the comment marker is
also has open paren syntax (see Bug#24870)."
  (with-temp-buffer
    (let ((table (make-syntax-table)))
      (modify-syntax-entry ?\{  "(}1nb" table)
      (modify-syntax-entry ?\}  "){4nb" table)
      (modify-syntax-entry ?-  ". 123" table)
      (set-syntax-table table))
    (insert "{-C-}\nX")
    (goto-char (point-min))
    (let* ((pointC (progn (search-forward "C") (1- (point))))
           (pointX (progn (search-forward "X") (1- (point))))
           (ppsC (parse-partial-sexp (point-min) pointC))
           (ppsX (parse-partial-sexp (point-min) pointX)))
      ;; C should be inside nestable comment, not list.
      (should (= (nth 0 ppsC) 0))
      (should (= (nth 4 ppsC) 1))
      (should (= (nth 8 ppsC) (- pointC 2)))
      ;; X should not be in comment or list.
      (should (= (nth 0 ppsX) 0))
      (should-not (nth 4 ppsX))
      ;; Try using OLDSTATE.
      (should (equal (parse-partial-sexp pointC pointX nil nil ppsC)
                     ppsX)))))


;;; Commentary:
;; The next bit tests the handling of comments in syntax.c, in
;; particular the function `forward-comment'.

;; It is intended to enhance this bit to test nested comments and also
;; the interaction of `parse-partial-sexp' and `scan-lists' with
;; comments (2020-10-01).

;; This bit uses the data file test/data/syntax-comments.txt.

(defun syntax-comments-point (n forw)
  "Return the buffer offset corresponding to the \"label\" N.
N is a decimal number which appears in the data file, usually
twice, as \"labels\".  It can also be a negative number or zero.
FORW is t when we're using the label at BOL, nil for the one at EOL.

If the label N doesn't exist in the current buffer, an exception
is thrown.

When FORW is t and N positive, we return the position after the
first occurrence of label N at BOL in the data file.  With FORW
nil, we return the position before the last occurrence of the
label at EOL in the data file.

When N is negative, we return instead the position of the end of
line that the -N label is on.  When it is zero, we return POINT."
  (if (zerop n)
      (point)
    (let ((str (format "%d" (abs n))))
      (save-excursion
	(if forw
	    (progn
	      (goto-char (point-min))
	      (re-search-forward
	       (concat "^\\(" str "\\)\\([^0-9\n]\\|$\\)"))
	      (if (< n 0)
		  (progn (end-of-line) (point))
		(match-end 1)))
	  (goto-char (point-max))
	  (re-search-backward
	   (concat "\\(^\\|[^0-9]\\)\\(" str "\\)$"))
	  (if (< n 0)
	      (progn (end-of-line) (point))
	    (match-beginning 2)))))))

(eval-and-compile
  (defvar syntax-comments-section))

(defmacro syntax-comments (-type- -dir- res start &optional stop)
  "Create an ERT test to test (forward-comment 1/-1).
The test uses a fixed name data file, which it visits.  It calls
entry and exit functions to set up and tear down syntax entries
for comment characters.  The test is given a name based on the
global variable `syntax-comments-section', the direction of
movement and the value of START.

-TYPE- (unquoted) is a symbol from whose name the entry and exit
function names are derived by appending \"-in\" and \"-out\".

-DIR- (unquoted) is `forward' or `backward', the direction
`forward-comment' is attempted.

RES, t or nil, is the expected result from `forward-comment'.

START and STOP are decimal numbers corresponding to labels in the
data file marking the start and expected stop positions.  See
`syntax-comments-point' for a precise specification.  If STOP is
missing or nil, the value of START is assumed for it."
  (declare (debug t))
  (let ((forw
	 (cond
	  ((eq -dir- 'forward) t)
	  ((eq -dir- 'backward) nil)
	  (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-))))
	(start-str (format "%d" (abs start)))
	(type -type-)
	)
    `(ert-deftest ,(intern (concat "syntax-comments-"
				   syntax-comments-section
				   (if forw "-f" "-b") start-str))
	 ()
       (with-current-buffer
	   (find-file
	    ,(expand-file-name "data/syntax-comments.txt"
			       (getenv "EMACS_TEST_DIRECTORY")))
	 (,(intern (concat (symbol-name type) "-in")))
	 (goto-char (syntax-comments-point ,start ,forw))
	 (let ((stop (syntax-comments-point ,(or stop start) ,(not forw))))
	   (should (eq (forward-comment ,(if forw 1 -1)) ,res))
	   (should (eq (point) stop)))
	 (,(intern (concat (symbol-name type) "-out")))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "Pascal" style comments - single character delimiters, the closing
;; delimiter not being newline.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun {-in ()
  (setq comment-end-can-be-escaped nil)
  (modify-syntax-entry ?{ "<")
  (modify-syntax-entry ?} ">"))
(defun {-out ()
  (modify-syntax-entry ?{ "(}")
  (modify-syntax-entry ?} "){"))
(eval-and-compile
  (setq syntax-comments-section "pascal"))

(syntax-comments { forward nil 20 0)
(syntax-comments { backward nil 20 0)
(syntax-comments { forward t 21)
(syntax-comments { backward t 21)
(syntax-comments { forward t 22)
(syntax-comments { backward t 22)

(syntax-comments { forward t 23)
(syntax-comments { backward t 23)
(syntax-comments { forward t 24)
(syntax-comments { backward t 24)
(syntax-comments { forward t 26)
(syntax-comments { backward t 26)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "Lisp" style comments - single character opening delimiters on line
;; comments.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun \;-in ()
  (setq comment-end-can-be-escaped nil)
  (modify-syntax-entry ?\n ">")
  (modify-syntax-entry ?\; "<"))
(defun \;-out ()
  (modify-syntax-entry ?\n " ")
  (modify-syntax-entry ?\; "."))
(eval-and-compile
  (setq syntax-comments-section "lisp"))

(syntax-comments \; backward nil 30 30)
(syntax-comments \; forward t 31)
(syntax-comments \; backward t 31)
(syntax-comments \; forward t 32)
(syntax-comments \; backward t 32)
(syntax-comments \; forward t 33)
(syntax-comments \; backward t 33)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun /*-in ()
  (setq comment-end-can-be-escaped t)
  (modify-syntax-entry ?/ ". 124b")
  (modify-syntax-entry ?* ". 23")
  (modify-syntax-entry ?\n "> b"))
(defun /*-out ()
  (setq comment-end-can-be-escaped nil)
  (modify-syntax-entry ?/ ".")
  (modify-syntax-entry ?* ".")
  (modify-syntax-entry ?\n " "))
(eval-and-compile
  (setq syntax-comments-section "c"))

(syntax-comments /* forward t 1)
(syntax-comments /* backward t 1)
(syntax-comments /* forward t 2)
(syntax-comments /* backward t 2)
(syntax-comments /* forward t 3)
(syntax-comments /* backward t 3)

(syntax-comments /* forward t 4)
(syntax-comments /* backward t 4)
(syntax-comments /* forward t 5 6)
(syntax-comments /* backward nil 5 0)
(syntax-comments /* forward nil 6 0)
(syntax-comments /* backward t 6 5)

(syntax-comments /* forward t 7 8)
(syntax-comments /* backward nil 7 0)
(syntax-comments /* forward nil 8 0)
(syntax-comments /* backward t 8 7)
(syntax-comments /* forward t 9)
(syntax-comments /* backward t 9)

(syntax-comments /* forward nil 10 0)
(syntax-comments /* backward nil 10 0)
(syntax-comments /* forward t 11)
(syntax-comments /* backward t 11)

(syntax-comments /* forward t 13 14)
(syntax-comments /* backward nil 13 -14)
(syntax-comments /* forward t 15)
(syntax-comments /* backward t 15)

;;; syntax-tests.el ends here