Changed op-precedence back to a memoized table (performance tweaks).

[clinton/parenscript.git] / t / test.lisp

diff --git a/t/test.lisp b/t/test.lisp
dissimilarity index 94%
index 651c6cb..ac390f5 100644 (file)
--- a/t/test.lisp
+++ b/t/test.lisp
@@ -1,75 +1,45 @@
-(in-package :js-test)
-
-;; Testcases for parenscript
-
-(defun trim-whitespace(str)
-  (string-trim '(#\Space #\Tab #\Newline) str))
-
-(defun same-space-between-statements(code)
-  (cl-ppcre:regex-replace-all "\\s*;\\s*" code (concatenate 'string (list #\; #\Newline))))
-
-(defun no-indentation(code)
-  (cl-ppcre:regex-replace-all (cl-ppcre:create-scanner "^\\s*" :multi-line-mode t) code ""))
-
-(defun no-trailing-spaces(code)
-  (cl-ppcre:regex-replace-all (cl-ppcre:create-scanner "\\s*$" :multi-line-mode t) code ""))
-
-(defun normalize-js-code(str)
-  (trim-whitespace (no-indentation (no-trailing-spaces (same-space-between-statements str)))))
-
-(defmacro test-ps-js (testname parenscript javascript)
-  `(test ,testname ()
-    (setf js::*var-counter* 0)
-    ;; is-macro expands its argument again when reporting failures, so
-    ;; the reported temporary js-variables get wrong if we don't evalute first.
-    (let ((generated-code (js-to-string ',parenscript))
-          (js-code ,javascript))
-      (is (string= (normalize-js-code generated-code)
-                   (normalize-js-code js-code))))))
-
-(defun run-tests()
-  (format t "Running reference tests:~&")
-  (run! 'ref-tests)
-  (format t "Running other tests:~&")
-  (run! 'ps-tests))
-
-;;---------------------------------------------------------------------------
-(def-suite ps-tests)
-(in-suite ps-tests)
-
-;; A problem with long nested operator, when the statement spanned several rows
-;; the rows would not be joined together correctly.
-(test-ps-js bug-dwim-join
-   (alert (html ((:div :id 777
-                       :style (css-inline :border "1pxsssssssssss"
-                                          :font-size "x-small"
-                                          :height (* 2 200)
-                                          :width (* 2 300))))))
-   "alert
-('<div id=\"777\" style=\"'
- + ('border:1pxsssssssssss;font-size:x-small;height:' + 2 * 200 + ';width:'
- + 2 * 300)
- + '\"></div>')") ;";This line should start with a plus character.
-
-
-(test-ps-js simple-slot-value
-  (let ((foo (create :a 1)))
-   (alert (slot-value foo 'a)))
-  "{
-    var foo = { a : 1 };
-    alert(foo.a);
-   }")
-
-(test-ps-js buggy-slot-value
-   (let ((foo (create :a 1))
-        (slot-name "a"))
-    (alert (slot-value foo slot-name)))
-  "{
-    var foo = { a : 1 };
-    var slotName = 'a';
-    alert(foo[slotName]);
-   }"); Last line was alert(foo.slotName) before bug-fix.
-
-(test-ps-js buggy-slot-value-two
-  (slot-value foo (get-slot-name))
-  "foo[getSlotName()]")
+(in-package "PS-TEST")
+
+(defun normalize-whitespace (str)
+  (substitute #\Space #\Newline (substitute #\Space #\Tab str)))
+    
+(defun same-space-between-statements (code)
+  (let ((cl-ppcre:*use-bmh-matchers* nil))
+    (cl-ppcre:regex-replace-all "\\s*;\\s*" code "; ")))
+    
+(defun remove-duplicate-spaces (str)
+  (labels ((spacep (char) (and char (char= char #\Space)))
+           (rds (list)
+             (cond ((null list) nil)
+                   ((and (spacep (first list)) (spacep (second list))) (rds (cons #\Space (cddr list))))
+                   (t (cons (car list) (rds (cdr list)))))))
+    (coerce (rds (coerce str 'list)) 'string)))
+  
+(defun trim-spaces (str)
+  (string-trim '(#\Space) str))
+  
+(defun remove-spaces-near-brackets (str)
+  (let ((cl-ppcre:*use-bmh-matchers* nil))
+    (reduce (lambda (str rex-pair) (cl-ppcre:regex-replace-all (first rex-pair) str (second rex-pair)))
+            (cons str '(("\\[ " "[") (" \\]" "]") ("\\( " "(") (" \\)" ")"))))))
+  
+(defun normalize-js-code (str)
+  (remove-spaces-near-brackets
+   (trim-spaces
+    (remove-duplicate-spaces
+     (same-space-between-statements
+      (normalize-whitespace str))))))
+
+(defmacro test-ps-js (testname parenscript javascript &key (js-target-version *js-target-version*))
+  `(test ,testname ()
+         (is (string= (normalize-js-code (let ((*js-target-version* ,js-target-version))
+                                           (ps-doc* ',parenscript)))
+                      (normalize-js-code ,javascript)))))
+
+(defun run-tests()
+  (format t "Running reference tests:~&")
+  (run! 'ref-tests)
+  (format t "Running other tests:~&")
+  (run! 'ps-tests)
+  (format t "Running Package System tests:~&")
+  (run! 'package-system-tests))