Initial test for the re-factored forward search token function

Author: sfavazza

sysver-bnf.el

@@ -39,6 +39,7 @@
 (defvar SYNTOK-PARAMS-START-LIST "SYNTOK-PARAMS-START-LIST")
 (defvar SYNTOK-ASSIGN-SEMICOLON-CLOSER "SYNTOK-ASSIGN-SEMICOLON-CLOSER")
 (defvar SYNTOK-SPACING "SYNTOK-SPACING")
+(defvar SYNTOK-STRING "SYNTOK-STRING")
 
 ;; token search functions
 
@@ -54,25 +55,57 @@
   ;; modify the default forward token function such that it returns a token even for
   ;; parenthesis characters "(" ")"
   (progn
-    (let ((start-pnt (point)))
-      ;; return the whole string as a token
-      ;; when inside a comment the `forward-comment' returns always `nil', moreover the strings
-      ;; shall be given  or a string the 
-      (forward-comment (point-max))
-
-      (if (> (point) start-pnt)
-          ;; we just skipped a space-comments group, hence the general inter-token is returned, the
-          ;; caller of this function will refine the search
-          SYNTOK-SPACING
-        (buffer-substring-no-properties
-         (point)
-         (cond
-          ((and (zerop (skip-syntax-forward "."))
-                (zerop (skip-syntax-forward "("))
-                (zerop (skip-syntax-forward ")")))))
-         (progn (if 
-                    (skip-syntax-forward "w_'"))
-                (point)))))))
+    (let* ((start-pnt (point))
+           (syntax-state (syntax-ppss start-pnt))
+           ;; do not try to get the state of the incremented point when at the end of the buffer
+           (syntax-state-next (if (not (eobp))
+                                  (save-excursion
+                                    (syntax-ppss (1+ start-pnt)))
+                                (syntax-class)))) ; it is expected a list so recycle the previous one
+
+      (cond
+       ;; the token search must stop when reaching the end of the buffer
+       ((eobp) nil)
+
+       ;; when inside a comment the `forward-comment' returns always `nil', hence use the syntax
+       ;; state to skip it
+       ((nth 4 syntax-state)
+        (goto-char (nth 8 syntax-state)) ; to the comment start to easily skip it
+        ;; move forward skipping comments and with characters
+        (forward-comment (point-max))
+        SYNTOK-SPACING)
+
+       ;; FIXME: the string case fails to leave a string context when the current string contains
+       ;; the escaped apexes.
+
+       ;; When inside of a string or just before a string opener character, a string-token shall be
+       ;; returned.
+       ((or (nth 3 syntax-state) (nth 3 syntax-state-next))
+        ;; skip all the characters inside the string (^ negate the class to be skipped)
+        (skip-syntax-forward "\"")      ; move inside the string when placed just before its opener
+        (skip-syntax-forward "^\"")     ; reach the string closer
+        (skip-syntax-forward "\"")      ; move after the string closer
+        SYNTOK-STRING)
+
+       ;; as not inside a comment or string search the next token based on the syntax class (after
+       ;; skipping comments and white spaces)
+       (t
+        (forward-comment (point-max))
+
+        (if (> (point) start-pnt)
+            ;; we just skipped a space-comments group, hence the general inter-token is returned, the
+            ;; caller of this function will refine the search
+            SYNTOK-SPACING
+          (buffer-substring-no-properties
+           (point)
+           (cond
+            ((and (zerop (skip-syntax-forward "."))
+                  (zerop (skip-syntax-forward "("))
+                  (zerop (skip-syntax-forward ")")))
+             (skip-syntax-forward "w_'")
+             (point))
+            (t (point)))
+           )))))))
 (defun sysver-basic-backward-token ()
   "Default backward search token function based on the syntax classes."
 

test/sysver-common.el

@@ -1,11 +1,17 @@
 ;;; sysver-test-common.el --- general definitions for various UTCs (Unit-Test-Case)
 
+;; NOTE: could not find a way to step-through a macro, there is a way to let edebug how to instrument your macro
+;; via a debug-declaration, but it's too complex.
+;; The easy work around is to expand the macro by placing the cursor right before the macro-call and execute the
+;; command: emacs-lisp-macroexpand
+;; After the debug is over, the buffer should be reverted to collapse the macro again.
 (defmacro sysver-utc-environment (test-string setup-to-test test-body)
   "Freshly reload the `sysver' major mode and setup the environment for an unit-test-case (UTC).
 
 The TEST-STRING is a string to be inserted into the current buffer.
 The SETUP-TO-TEST should be an unquoted list of statements to setup the feature under test, while
 the TEST-BODY is an unquoted list of statements to verify the tested feature."
+  (declare (debug (form sexp sexp)))
 
   `(progn
      ;; reload sysver

test/sysver-token-test.el

@@ -3,6 +3,7 @@
 (require 'ert)
 (require 'sysver)
 (require 'sysver-common)
+(require 'cl-lib)
 
 (ert-deftest sysver-test-default-token-search ()
   "Test the default token search behavior"
@@ -18,12 +19,16 @@
                         "// a commment to test the synthetic-token generation"))
 
          ;; list of all expected tokens: the REAL-TOKENS list interleaved with SYNTOK-SPACING tokens
-         (exp-tokens (let (full-tok-list '())
+         (exp-tokens (let ((full-tok-list '()))
+                       ;; interleave the expected tokens list with SYNTOK-SPACING
                        (dolist (token real-tokens full-tok-list)
                          (setq full-tok-list (append full-tok-list `(,token ,SYNTOK-SPACING))))
-                       ;; Refine the output list as the last comment shall be matched together with the previous
-                       ;; space character (hence the obtained list less the last tokens).
-                       (setq full-tok-list (butlast full-tok-list 2))))
+                       ;; Refine the output list:
+                       ;; - the string shall be returned as a SYNTOK-STRING token
+                       ;; - the last comment shall be part of the previous space, hence remove the last 2 tokens
+                       (setq full-tok-list (append (cl-subseq full-tok-list 0 4)
+                                                   `(,SYNTOK-STRING)
+                                                   (cl-subseq full-tok-list 5 (- (length full-tok-list) 2))))))
 
          ;; turn the REAL-TOKENS list into a space-interleaved-list
          (current-string (mapconcat 'identity real-tokens " "))