[elpa] externals/phps-mode d828738 3/4: Started on test for native tokens

[Christian Johansson]

branch: externals/phps-mode
commit d82873835138ba3a1fc450f5093fbfc2ea0a8b5b
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    Started on test for native tokens
---
 phps-mode-test.el | 44 +++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 43 insertions(+), 1 deletion(-)

diff --git a/phps-mode-test.el b/phps-mode-test.el
index 7ec869b..d21a20b 100644
--- a/phps-mode-test.el
+++ b/phps-mode-test.el
@@ -27,6 +27,11 @@
 (require 'phps-mode)
 (require 'phps-mode-macros)
 
+(defvar
+  phps-mode-test--native-tokens
+  nil
+  "The native tokens of PHP parser (if available).")
+
 (defmacro phps-mode-test--incremental-vs-intial-buffer (source &optional title 
&rest change)
   "Set up test buffer with SOURCE, TITLE, apply CHANGE and compare incremental 
values with initial values."
   `(let ((test-buffer-incremental (generate-new-buffer "test-incremental"))
@@ -110,9 +115,46 @@
      (insert ,source)
      (goto-char 0)
      (phps-mode-debug-message
-       (message "\nTesting buffer '%s':\n'%s'\n" ,title ,source))
+      (message "\nTesting buffer '%s':\n'%s'\n" ,title ,source))
      (phps-mode)
      ,@body
+
+     (let ((lexer-tokens phps-mode-lex-analyzer--tokens))
+       (setq phps-mode-test--native-tokens nil)
+       (with-temp-buffer
+         (let ((filename (expand-file-name "lexer-test.tmp"))
+               (filename2 (expand-file-name "lexer-test2.tmp")))
+           (insert "<?php ini_set('display_errors', false); 
ini_set('error_reporting', false); if (function_exists('token_get_all')) { 
$tokens = token_get_all(file_get_contents(\"lexer-test2.tmp\")); echo \"'(\"; 
foreach ($tokens as $token) { echo \"\n  \"; if (is_array($token)) { echo 
token_name($token[0]); } else { echo '\"' . $token . '\"'; }} echo \"\n)\";}")
+           (write-file filename)
+           (kill-region (point-min) (point-max))
+           (insert ,source)
+           (write-file filename2)
+           (kill-region (point-min) (point-max))
+
+           (let* ((native-tokens
+                   (call-process
+                    "php"
+                    nil
+                    t
+                    t
+                    (concat "-f" filename))))
+             (when (= native-tokens 0)
+               ;; (message "native-tokens: %S %s" native-tokens 
(buffer-substring-no-properties (point-min) (point-max)))
+               (let ((tokens (eval (car (read-from-string 
(buffer-substring-no-properties (point-min) (point-max)))))))
+                 (setq
+                  phps-mode-test--native-tokens
+                  tokens)
+                 (let ((trimmed-tokens))
+                   (dolist (token lexer-tokens)
+                     (push (car token) trimmed-tokens)
+                     )
+                   (setq trimmed-tokens (reverse trimmed-tokens))
+                   (should
+                    (equal
+                     trimmed-tokens
+                     phps-mode-test--native-tokens))
+                   (message "Native tokens matches elisp tokens"))))))))
+     
      (kill-buffer test-buffer)
      (when ,title
        (message "\nPassed tests for '%s'\n" ,title))))