From: Raimon Grau <raimon@3scale.net>
Date: Thu, 2 May 2013 19:00:57 +0000 (+0200)
Subject: Merge branch 'origin-master' into origin-format
X-Git-Url: http://repo.macrolet.net/gitweb/?p=jscl.git;a=commitdiff_plain;h=13b34bf604807174b4ed9a18d5e82678557b7c4e

Merge branch 'origin-master' into origin-format

Conflicts:
	jscl.lisp
	src/print.lisp
	src/toplevel.lisp
---

13b34bf604807174b4ed9a18d5e82678557b7c4e
diff --cc jscl.lisp
index 33b8f15,aae6ee9..6d907a3
--- a/jscl.lisp
+++ b/jscl.lisp
@@@ -82,9 -81,18 +81,18 @@@
          (ls-compile-file (source-pathname (car input) :type "lisp") out))))
    ;; Tests
    (with-open-file (out "tests.js" :direction :output :if-exists :supersede)
-     (dolist (input *source*)
-       (when (member (cadr input) '(:test))
-         (ls-compile-file (source-pathname (car input)
-                                           :directory '(:relative "tests")
-                                           :type "lisp")
-                          out)))))
+     (dolist (input (append (directory "tests.lisp")
+                            (directory "tests/*.lisp")
 -                           (directory "tests-report.lisp"))) 
++                           (directory "tests-report.lisp")))
+       (ls-compile-file input out))))
+ 
+ 
+ ;;; Run the tests in the host Lisp implementation. It is a quick way
+ ;;; to improve the level of trust of the tests.
+ (defun run-tests-in-host ()
+   (load "tests.lisp")
+   (let ((*use-html-output-p* nil))
+     (declare (special *use-html-output-p*))
+     (dolist (input (directory "tests/*.lisp"))
+       (load input)))
+   (load "tests-report.lisp"))
diff --cc src/print.lisp
index 7453829,dfa1b69..9db5354
--- a/src/print.lisp
+++ b/src/print.lisp
@@@ -18,57 -18,51 +18,61 @@@
  
  ;;; Printer
  
 -(defun prin1-to-string (form)
 +(defvar *print-escape* t)
 +
 +(defun write-to-string (form)
    (cond
-    ((symbolp form)
-     (multiple-value-bind (symbol foundp)
- 	(find-symbol (symbol-name form) *package*)
-       (if (and foundp (eq symbol form))
- 	  (symbol-name form)
- 	(let ((package (symbol-package form))
- 	      (name (symbol-name form)))
- 	  (concat (cond
- 		   ((null package) "#")
- 		   ((eq package (find-package "KEYWORD")) "")
- 		   (t (package-name package)))
- 		  ":" name)))))
-    ((integerp form) (integer-to-string form))
-    ((floatp form) (float-to-string form))
-    ((stringp form) (if *print-escape*
- 		       (concat "\"" (escape-string form) "\"")
- 		     form))
-    ((functionp form)
-     (let ((name (oget form "fname")))
-       (if name
- 	  (concat "#<FUNCTION " name ">")
- 	(concat "#<FUNCTION>"))))
-    ((listp form)
-     (concat "("
- 	    (join-trailing (mapcar #'write-to-string (butlast form)) " ")
- 	    (let ((last (last form)))
- 	      (if (null (cdr last))
- 		  (write-to-string (car last))
- 		(concat (write-to-string (car last)) " . " (write-to-string (cdr last)))))
- 	    ")"))
-    ((arrayp form)
-     (concat "#" (if (zerop (length form))
- 		    "()"
- 		  (write-to-string (vector-to-list form)))))
-    ((packagep form)
-     (concat "#<PACKAGE " (package-name form) ">"))
-    (t
-     (concat "#<javascript object>"))))
+     ((symbolp form)
+      (multiple-value-bind (symbol foundp)
+          (find-symbol (symbol-name form) *package*)
+        (if (and foundp (eq symbol form))
+            (symbol-name form)
+            (let ((package (symbol-package form))
+                  (name (symbol-name form)))
+              (concat (cond
+                        ((null package) "#")
+                        ((eq package (find-package "KEYWORD")) "")
+                        (t (package-name package)))
+                      ":" name)))))
+     ((integerp form) (integer-to-string form))
+     ((floatp form) (float-to-string form))
+     ((characterp form)
 -     (concat "#\\" 
++     (concat "#\\"
+              (case form
+                (#\newline "newline")
+                (#\space "space")
+                (otherwise (string form)))))
+     ((stringp form) (concat "\"" (escape-string form) "\""))
+     ((functionp form)
+      (let ((name (oget form "fname")))
+        (if name
+            (concat "#<FUNCTION " name ">")
+            (concat "#<FUNCTION>"))))
+     ((listp form)
+      (concat "("
 -             (join-trailing (mapcar #'prin1-to-string (butlast form)) " ")
++             (join-trailing (mapcar #'write-to-string (butlast form)) " ")
+              (let ((last (last form)))
+                (if (null (cdr last))
 -                   (prin1-to-string (car last))
 -                   (concat (prin1-to-string (car last)) " . " (prin1-to-string (cdr last)))))
++                   (write-to-string (car last))
++                   (concat (write-to-string (car last)) " . " (write-to-string (cdr last)))))
+              ")"))
+     ((arrayp form)
+      (concat "#" (if (zerop (length form))
+                      "()"
 -                     (prin1-to-string (vector-to-list form)))))
++                     (write-to-string (vector-to-list form)))))
+     ((packagep form)
+      (concat "#<PACKAGE " (package-name form) ">"))
+     (t
+      (concat "#<javascript object>"))))
  
 +(defun prin1-to-string (form)
 +  (let ((*print-escape* t))
 +    (write-to-string form)))
 +
 +(defun princ-to-string (form)
 +  (let ((*print-escape* nil))
 +    (write-to-string form)))
 +
  (defun write-line (x)
    (write-string x)
    (write-string *newline*)
diff --cc src/toplevel.lisp
index ba9b129,c32dfbb..d6f8cb4
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@@ -54,10 -59,10 +59,10 @@@
            define-symbol-macro defmacro defparameter defun defvar
            digit-char digit-char-p disassemble do do* documentation
            dolist dotimes ecase eq eql equal error eval every export expt
 -          fdefinition find-package find-symbol first flet fourth fset
 +          fdefinition find-package find-symbol first flet format fourth fset
-           funcall function functionp gensym get-setf-expansion
-           get-universal-time go identity if in-package incf integerp
-           intern keywordp labels lambda last length let let* list
+           funcall function functionp gensym get-internal-real-time
+           get-setf-expansion get-universal-time go identity if in-package
+           incf integerp intern keywordp labels lambda last length let let* list
            list* list-all-packages listp loop make-array make-package
            make-symbol mapcar member minusp mod multiple-value-bind
            multiple-value-call multiple-value-list multiple-value-prog1