Add test for incremental parser accuracy and fix some gnarly parser bugs

phpinspect-bmap.el

@@ -170,20 +170,20 @@
         (push token existing-end)
       (puthash end (list token-meta) ends))
 
-    (puthash token token-meta meta)
+     (puthash token token-meta meta)
 
-    (when (and last-token-start
-               (<= start last-token-start))
-      (let ((child)
-            (stack (phpinspect-bmap-token-stack bmap)))
-        (while (and (car stack) (>= (phpinspect-meta-start (car stack)) start))
-          (setq child (pop stack))
-          (phpinspect-meta-set-parent child token-meta))
+     (when (and last-token-start
+                (<= start last-token-start))
+       (let ((child)
+             (stack (phpinspect-bmap-token-stack bmap)))
+         (while (and (car stack) (>= (phpinspect-meta-start (car stack)) start))
+           (setq child (pop stack))
+           (phpinspect-meta-set-parent child token-meta))
 
-          (setf (phpinspect-bmap-token-stack bmap) stack)))
+         (setf (phpinspect-bmap-token-stack bmap) stack)))
 
-    (setf (phpinspect-bmap-last-token-start bmap) start)
-    (push token-meta (phpinspect-bmap-token-stack bmap))))
+     (setf (phpinspect-bmap-last-token-start bmap) start)
+     (push token-meta (phpinspect-bmap-token-stack bmap))))
 
 (define-inline phpinspect-pctx-register-token (pctx token start end)
   (inline-letevals (pctx)
@@ -208,7 +208,7 @@
 (cl-defmethod phpinspect-bmap-token-starting-at ((bmap phpinspect-bmap) point)
   (let ((overlay (phpinspect-bmap-overlay-at-point bmap point)))
     (if overlay
-          (phpinspect-bmap-token-starting-at overlay point)
+        (phpinspect-bmap-token-starting-at overlay point)
       (gethash point (phpinspect-bmap-starts bmap)))))
 
 (cl-defmethod phpinspect-bmap-tokens-ending-at ((overlay (head overlay)) point)

phpinspect-index.el

@@ -197,18 +197,23 @@ function (think \"new\" statements, return types etc.)."
   (seq-filter #'phpinspect-var-annotation-p token))
 
 (define-inline phpinspect-var-annotation-variable (annotation)
-  (inline-quote (cadr (caddr ,annotation))))
+  "Return ANNOTATION's variable name if and only if its structure is correct."
+  (inline-letevals ((variable-name (inline-quote (cadr (caddr ,annotation)))))
+    (inline-quote (and (stringp ,variable-name)
+                       ,variable-name))))
 
 (define-inline phpinspect-var-annotation-type (annotation)
-  (inline-quote (cadadr ,annotation)))
+  "Returns ANNOTATION's variable type if and only if its structure is correct."
+  (inline-letevals ((variable-type (inline-quote (cadadr ,annotation))))
+    (inline-quote (and (stringp ,variable-type) ,variable-type))))
 
 (defun phpinspect--find-var-annotation-for-variable (annotation-list variable &optional predicate)
   (catch 'return
     (dolist (annotation annotation-list)
       (when (and (or (phpinspect-var-annotation-p annotation) (and predicate (funcall predicate annotation)))
                  (phpinspect-var-annotation-variable annotation)
-                 (string= (phpinspect-var-annotation-variable annotation)
-                          variable))
+                 (equal (phpinspect-var-annotation-variable annotation)
+                        variable))
         (throw 'return annotation)))
     nil))
 

phpinspect-parse-context.el

@@ -61,6 +61,9 @@ thrown.")
   (whitespace-before ""
                      :type string))
 
+(define-inline phpinspect-pctx-whitespace-before-length (ctx)
+  (inline-quote (length (phpinspect-pctx-whitespace-before ,ctx))))
+
 (defmacro phpinspect-with-parse-context (ctx &rest body)
   (declare (indent 1))
   (let ((old-ctx (gensym))
@@ -78,13 +81,14 @@ thrown.")
          (progn
            (unless ,completed (phpinspect-pctx-cancel ,ctx))
            (setq phpinspect-parse-context ,old-ctx))))))
+
 (defmacro phpinspect-pctx-save-whitespace (pctx &rest body)
   (declare (indent 1))
   (let ((save-sym (gensym)))
     `(let ((,save-sym (phpinspect-pctx-whitespace-before ,pctx)))
        (unwind-protect
            (progn
-             (setf (phpinspect-pctx-whitespace-before ,pctx) nil)
+             (setf (phpinspect-pctx-whitespace-before ,pctx) "")
              ,@body)
          (setf (phpinspect-pctx-whitespace-before ,pctx) ,save-sym)))))
 
@@ -120,8 +124,9 @@ thrown.")
          (throw 'phpinspect-parse-interrupted nil))))))
 
 (define-inline phpinspect-pctx-register-whitespace (pctx whitespace)
-  (inline-quote
-   (setf (phpinspect-pctx-whitespace-before ,pctx) ,whitespace)))
+  (inline-letevals (pctx)
+    (inline-quote
+     (setf (phpinspect-pctx-whitespace-before ,pctx) ,whitespace))))
 
 (defsubst phpinspect-pctx-consume-whitespace (pctx)
   (let ((whitespace (phpinspect-pctx-whitespace-before pctx)))

phpinspect-parser.el

@@ -38,10 +38,6 @@
   (inline-letevals (string)
     (inline-quote
      (progn
-       (when phpinspect-parse-context
-         (phpinspect-pctx-register-whitespace
-          phpinspect-parse-context
-          (substring ,string (- (length ,string) 1) (length ,string))))
        (substring ,string 0 (- (length ,string) 1))))))
 
 (defsubst phpinspect-munch-token-without-attribs (string token-keyword)
@@ -178,11 +174,13 @@ token is \";\", which marks the end of a statement in PHP."
            tokens))))
 
 
-  (defun phpinspect-make-incremental-parser-function (name tree-type handlers &optional delimiter-predicate delimiter-condition)
+  (defun phpinspect-make-incremental-parser-function
+      (name tree-type handlers &optional delimiter-predicate delimiter-condition)
     "Like `phpinspect-make-parser-function', but returned function
 is able to reuse an already parsed tree."
     (cl-assert (symbolp delimiter-predicate))
-    `(defun ,(phpinspect-parser-func-name name "incremental") (context buffer max-point &optional skip-over continue-condition root)
+    `(defun ,(phpinspect-parser-func-name name "incremental")
+         (context buffer max-point &optional skip-over continue-condition root)
        (with-current-buffer buffer
          (let* ((tokens (cons ,tree-type nil))
                 (tokens-rear tokens)
@@ -201,7 +199,11 @@ is able to reuse an already parsed tree."
                 (delta)
                 (token))
            (when skip-over (forward-char skip-over))
+
            (phpinspect-pctx-save-whitespace context
+             (when (looking-at (phpinspect-handler-regexp whitespace))
+               (,(phpinspect-handler-func-name 'whitespace) (match-string 0)))
+
              (while (and (< (point) max-point)
                          (if continue-condition (funcall continue-condition) t)
                          (not ,(if delimiter-predicate
@@ -245,10 +247,22 @@ is able to reuse an already parsed tree."
                             (when token
                               (phpinspect-pctx-register-token context token start-position (point)))))
                         handlers)
-                     (t (forward-char)))
+                     ;; When no handlers match, whitespace can be discarded (if
+                     ;; we call forward-char, it probably won't be accurate
+                     ;; anymore anyways. One reason that no handlers matched
+                     ;; could be that this parser does not have the whitespace
+                     ;; handler and as such does not contain relevant
+                     ;; whitespace.
+                     (t (phpinspect-pctx-consume-whitespace context)
+                        (forward-char)))
                (when token
                  (setq tokens-rear (setcdr tokens-rear (cons token nil)))
-                 (setq token nil))))
+                 (setq token nil)))
+
+             ;; When there is unconsumed whitespace, move back. It should not be
+             ;; included in the current parent token's length.
+             (backward-char (length (phpinspect-pctx-consume-whitespace context))))
+
            (when root
              (phpinspect-pctx-register-token context tokens root-start (point)))
 
@@ -446,12 +460,12 @@ nature like argument lists"
                     (current-buffer)
                     max-point
                     (length start-token)
-                    (lambda () (not (and (char-equal (char-after) ?\)) (setq complete-list t)))))))
+                    (lambda () (not (and (char-equal (char-after) ?\)) (setq complete-list (point))))))))
 
     (if complete-list
         ;; Prevent parent-lists (if any) from exiting by skipping over the
         ;; ")" character
-        (forward-char)
+        (goto-char (+ complete-list 1))
       (setcar php-list :incomplete-list))
     php-list))
 
@@ -663,11 +677,11 @@ static keywords with the same meaning as in a class block."
   (let* ((complete-block nil)
          (continue-condition (lambda ()
                                (not (and (char-equal (char-after) ?})
-                                         (setq complete-block t)))))
+                                         (setq complete-block (point))))))
          (parsed (phpinspect--parse-block-without-scopes
-                  (current-buffer) max-point (length start-token) continue-condition 'root)))
+                  (current-buffer) max-point (length start-token) continue-condition)))
     (if complete-block
-        (forward-char)
+        (goto-char (+ complete-block 1))
       (setcar parsed :incomplete-block))
     parsed))
 
@@ -685,11 +699,11 @@ static keywords with the same meaning as in a class block."
   (let* ((complete-block nil)
          (continue-condition (lambda ()
                                (not (and (char-equal (char-after) ?})
-                                         (setq complete-block t)))))
+                                         (setq complete-block (point))))))
          (parsed (phpinspect--parse-class-block
-                  (current-buffer) max-point (length start-token) continue-condition 'root)))
+                  (current-buffer) max-point (length start-token) continue-condition)))
     (if complete-block
-        (forward-char)
+        (goto-char (+ complete-block 1))
       (setcar parsed :incomplete-block))
     parsed))
 
@@ -704,14 +718,14 @@ static keywords with the same meaning as in a class block."
                                ;; When we encounter a closing brace for this
                                ;; block, we can mark the block as complete.
                                (not (and (char-equal (char-after) ?})
-                                         (setq complete-block t)))))
+                                         (setq complete-block (point))))))
          (parsed (phpinspect--parse-block
                   (current-buffer) max-point (length start-token) continue-condition)))
     (if complete-block
         ;; After meeting the char-after requirement above, we need to move
         ;; one char forward to prevent parent-blocks from exiting because
         ;; of the same char.
-        (forward-char)
+        (goto-char (+ complete-block 1))
       (setcar parsed :incomplete-block))
     parsed))
 
@@ -775,10 +789,11 @@ Returns the consumed text string without face properties."
     (if (or (phpinspect-end-of-token-p (car (last declaration)))
             (not (looking-at (phpinspect-handler-regexp block))))
         (list :function declaration)
-      (list :function
-            declaration
-            (phpinspect--block-without-scopes-handler
-             (char-to-string (char-after)) max-point)))))
+      `(:function
+        ,declaration
+       ,@(cdr (phpinspect--parse-function-body (current-buffer) max-point))))))
+;; (phpinspect--block-without-scopes-handler
+;;  (char-to-string (char-after)) max-point)))))
 
 (phpinspect-defparser scope-public
   :tree-keyword "public"
@@ -869,9 +884,15 @@ the properties of the class"
                 max-point
                 (lambda () (not (char-equal (char-after) ?{)))
                 'root)
-           ,@(when (looking-at (phpinspect--class-block-handler-regexp))
-                (list (phpinspect--class-block-handler
-                       (char-to-string (char-after)) max-point)))))
+           ,@(cdr (phpinspect--parse-class-body (current-buffer) max-point nil))))
+
+(phpinspect-defparser class-body
+  :handlers '(whitespace comment class-block)
+  :delimiter-predicate #'phpinspect-block-p)
+
+(phpinspect-defparser function-body
+  :handlers '(whitespace comment block-without-scopes)
+  :delimiter-predicate #'phpinspect-block-p)
 
 (phpinspect-defparser root
   :tree-keyword "root"

phpinspect-resolvecontext.el

@@ -158,7 +158,7 @@ it would no longer be valid for the new enclosing tokens."
             (throw 'break nil)))))
 
     (phpinspect--log "Initial resolvecontext subject token: %s"
-             (phpinspect-meta-token subject))
+                     (phpinspect-meta-token subject))
     (when subject
       (setq subject-token
             (mapcar #'phpinspect-meta-token
@@ -169,6 +169,7 @@ it would no longer be valid for the new enclosing tokens."
                        subject-token (phpinspect-meta-token
                                       (phpinspect-meta-parent subject)))
 
+
       ;; Iterate through subject parents to build stack of enclosing tokens
       (let ((parent (phpinspect-meta-parent subject)))
         (while parent

test/test-buffer.el

@@ -26,6 +26,7 @@
 (require 'ert)
 (require 'phpinspect-parser)
 (require 'phpinspect-buffer)
+(require 'phpinspect-imports)
 (require 'phpinspect-test-env
          (expand-file-name "phpinspect-test-env.el"
                            (file-name-directory (macroexp-file-name))))
@@ -262,7 +263,6 @@ class YYY {
       (kill-line))
 
     (setq parsed-after (phpinspect-buffer-parse buffer 'no-interrupt))
-
     (should (equal parsed parsed-after))
 
     ;; Delete namespace declaration
@@ -286,6 +286,68 @@ class YYY {
 
     (should (equal parsed parsed-after))))
 
+(ert-deftest phpinspect-buffer-parse-incrementally-use ()
+  (with-temp-buffer
+  (let* ((buffer (phpinspect-make-buffer
+                  :buffer (current-buffer))))
+
+
+    (setq-local phpinspect-current-buffer buffer)
+
+    (insert
+     "<?php
+
+namespace XXX;
+
+use ZZZ\\zzz;
+use AAA\\BBB;  // comment
+
+use CCC;
+
+")
+
+    (add-hook 'after-change-functions #'phpinspect-after-change-function)
+    (phpinspect-buffer-parse buffer 'no-interrupt)
+    (let ((switch nil)
+          (delta 0))
+
+      (dotimes (i 100)
+        (if switch
+            (progn
+              (setq delta 0)
+              (goto-char 44)
+              (insert "hh")
+              (should (phpinspect-edtrack-edits (phpinspect-buffer-edit-tracker buffer)))
+              (should (= 51 (phpinspect-edtrack-current-position-at-point (phpinspect-buffer-edit-tracker buffer) 49))))
+          (progn
+            (setq delta (- 2))
+            (goto-char 44)
+            (delete-char 2)
+            (should (phpinspect-edtrack-edits (phpinspect-buffer-edit-tracker buffer)))
+            (should (= 47 (phpinspect-edtrack-current-position-at-point (phpinspect-buffer-edit-tracker buffer) 49)))))
+
+        (setq switch (not switch))
+
+        (phpinspect-buffer-parse buffer 'no-interrupt)
+
+    (let ((use (phpinspect-find-first-use (phpinspect-meta-find-first-child-matching-token
+                                           (phpinspect-buffer-root-meta buffer)
+                                           #'phpinspect-namespace-p))))
+
+      (should use)
+      (should (= 2 (length (phpinspect-meta-whitespace-before use))))
+      (should (= 24 (phpinspect-meta-start use)))
+      (should (= 36 (phpinspect-meta-end use)))
+
+      (let ((sibling (phpinspect-meta-find-right-sibling use)))
+        (should sibling)
+        (should (= 37 (phpinspect-meta-start sibling)))
+        (should (= (+ delta 49) (phpinspect-meta-end sibling)))
+
+        (let ((2nd-sibling (phpinspect-meta-find-right-sibling (phpinspect-meta-find-right-sibling sibling))))
+          (should 2nd-sibling)
+          (should (= (+ delta 63) (phpinspect-meta-start 2nd-sibling)))
+          (should (= (+ delta 71) (phpinspect-meta-end 2nd-sibling)))))))))))
 
 (ert-deftest phpinspect-buffer-index-classes ()
   (let* ((buffer (phpinspect-make-buffer :-project (phpinspect--make-project :autoload (phpinspect-make-autoloader))))