Merge remote-tracking branch 'origin/develop'

CHANGELOG.md

@@ -1,7 +1,13 @@
-## PENDING v1.1.3
+## v1.1.3
 
 Changes relative to [v1.1.2](#v112)
 
+* LispWorks 8 Structure Serialization
+* Fix error when reading/writing from/to pathnames on LispWorks (https://github.com/Zulu-Inuoe/jzon/issues/56)
+* Export `jzon:parser`
+* Fix unit tests on LispWorks (https://github.com/Zulu-Inuoe/jzon/issues/57)
+* Fix stack overflow on deeply nested JSON on SBCL 2.3.10+
+
 ## v1.1.2
 
 Changes relative to [v1.1.1](#v111)

README.md

@@ -1,6 +1,6 @@
 # jzon
 
-A correct and safe(er) JSON [RFC 8259][JSONRFC] parser with sane defaults.
+A correct and safe(er) JSON [RFC 8259][JSONRFC] reader/writer with sane defaults.
 
 Please see the section [Motivation and Features](#motivation-and-features) for a set of motivations driving jzon and why you should consider it over the other hundred options available for JSON in CL.
 

src/com.inuoe.jzon.asd

@@ -1,6 +1,6 @@
 (defsystem #:com.inuoe.jzon
-  :version "1.1.2"
-  :description "A correct and safe(er) JSON RFC 8259 parser with sane defaults."
+  :version "1.1.3"
+  :description "A correct and safe(r) JSON RFC 8259 reader/writer with sane defaults."
   :author "Wilfredo Velázquez-Rodríguez <zulu.inuoe@gmail.com>"
   :license "MIT"
   :depends-on (#:closer-mop

src/jzon.lisp

@@ -5,6 +5,7 @@
    #:parse
 
    ;;;; Streaming reader
+   #:parser
    #:make-parser
    #:parse-next
    #:parse-next-element
@@ -249,16 +250,16 @@ see `json-atom'"
   (macrolet ((%read-code-point ()
               `(logior (ash (or (digit-char-p (or (%step step) (%raise 'json-eof-error pos "Unexpected end of input reading unicode escape code in string")) 16)
                                (%raise 'json-parse-error pos "Non-digit in unicode escape code in string"))
-                           12)
-                      (ash (or (digit-char-p (or (%step step) (%raise 'json-eof-error pos "Unexpected end of input reading unicode escape code in string")) 16)
+                            12)
+                       (ash (or (digit-char-p (or (%step step) (%raise 'json-eof-error pos "Unexpected end of input reading unicode escape code in string")) 16)
                                (%raise 'json-parse-error pos "Non-digit in unicode escape code in string"))
-                           8)
-                      (ash (or (digit-char-p (or (%step step) (%raise 'json-eof-error pos "Unexpected end of input reading unicode escape code in string")) 16)
+                            8)
+                       (ash (or (digit-char-p (or (%step step) (%raise 'json-eof-error pos "Unexpected end of input reading unicode escape code in string")) 16)
                                (%raise 'json-parse-error pos "Non-digit in unicode escape code in string"))
-                           4)
-                      (ash (or (digit-char-p (or (%step step) (%raise 'json-eof-error pos "Unexpected end of input reading unicode escape code in string")) 16)
-                               (%raise 'json-parse-error pos "Non-digit in unicode escape code in string"))
-                           0))))
+                            4)
+                       (ash (or (digit-char-p (or (%step step) (%raise 'json-eof-error pos "Unexpected end of input reading unicode escape code in string")) 16)
+                                (%raise 'json-parse-error pos "Non-digit in unicode escape code in string"))
+                            0))))
     (let ((code-point (%read-code-point)))
       (code-char
        (if (<= #xD800 code-point #xDBFF)
@@ -329,7 +330,7 @@ see `json-atom'"
                      (let ((exp10 (+ exp10 (* exp-sign exp-val))))
                        (return  (values
                                   (or (el:make-double mantissa exp10 (minusp sign))
-                                  (rtd:ratio-to-double (* mantissa (expt 10 exp10) sign)))
+                                      (rtd:ratio-to-double (* mantissa (expt 10 exp10) sign)))
                                   c)))
                      c))))
     (prog ((sign 1)
@@ -400,7 +401,6 @@ see `json-atom'"
   (declare (type (integer 1) n))
   (loop :with line :of-type (integer 1)  := 1
         :with col :of-type (integer 1) := 1
-        :with cr := nil
         :for p :from 0 :below (1- n)
         :for c := (%step step)
         :do (case c
@@ -700,7 +700,7 @@ see `close-parser'"
   (multiple-value-bind (input close-action)
       (typecase in
         (pathname
-          (let ((f (open in :direction :input :external-format :utf-8)))
+          (let ((f (open in :direction :input :external-format :utf-8 :element-type 'character)))
             (values f (lambda () (close f)))))
         (t (values in (lambda ()))))
     (let ((parser (make-instance 'parser))
@@ -960,17 +960,16 @@ see `close-parser'"
         (%allow-comments (slot-value parser '%allow-comments))
         (%allow-multiple-content (slot-value parser '%allow-multiple-content))
         (%parser-state (slot-value parser '%parser-state)))
-    (declare (dynamic-extent stack key len))
     (declare (type list stack key len))
     (macrolet ((finish-value (value)
                  `(let ((value ,value))
                     (if (null stack)
                       (return value)
                       (let ((container (car stack)))
                         (if (listp container)
-                          (progn (push value (the list (car stack)))
+                          (progn (setf (car stack) (cons value (the list container)))
                                  (incf (the (integer 0) (car len))))
-                          (setf (gethash (pop key) (the hash-table (car stack))) value))))))
+                          (setf (gethash (pop key) (the hash-table container)) value))))))
                (inc-depth ()
                  `(progn
                    (when (= depth %max-depth)
@@ -1016,7 +1015,6 @@ see `close-parser'"
         stack
         key
         len)
-    (declare (dynamic-extent %parser-state stack key))
     (declare (type (integer 0 #xFFFF) depth))
     (declare (type list stack key len))
     (macrolet ((finish-value (value &optional check-lc)
@@ -1032,9 +1030,9 @@ see `close-parser'"
                         (setf top value))
                       (let ((container (car stack)))
                         (if (listp container)
-                          (progn (push value (the list (car stack)))
+                          (progn (setf (car stack) (cons value (the list container)))
                                  (incf (the (integer 0) (car len))))
-                          (setf (gethash (pop key) (the hash-table (car stack))) value))))))
+                          (setf (gethash (pop key) (the hash-table container)) value))))))
                 (inc-depth ()
                   `(progn
                     (when (= depth %max-depth)
@@ -1125,7 +1123,7 @@ see `close-parser'"
 
     (typecase in
       (pathname
-       (with-open-file (in in :direction :input :external-format :utf-8)
+       (with-open-file (in in :direction :input :external-format :utf-8 :element-type 'character)
          (parse in :max-depth max-depth :allow-comments allow-comments :allow-trailing-comma allow-trailing-comma :allow-multiple-content allow-multiple-content :max-string-length max-string-length :key-fn key-fn)))
       (t
         (multiple-value-bind (%step %read-string %pos) (%make-fns in max-string-length)
@@ -1156,7 +1154,7 @@ Example return value:
 ")
     (:method (element)
       nil)
-    #+(or ccl clisp sbcl)
+    #+(or ccl clisp sbcl lispworks8)
     (:method ((element structure-object))
       (%coerced-fields-slots element))
     (:method ((element standard-object))
@@ -1305,7 +1303,8 @@ Example return value:
           (let ((stream (open stream :direction :output
                                      :if-does-not-exist :create
                                      :if-exists :supersede
-                                     :external-format :utf-8)))
+                                     :external-format :utf-8
+                                     :element-type 'character)))
             (values stream (lambda () (close stream)))))
         ((streamp stream)
           (unless (output-stream-p stream)

test/jzon-tests.lisp

@@ -1177,23 +1177,23 @@
   (is (string= "5" (jzon:stringify 5)))
   (is (string= "0" (jzon:stringify 0))))
 
-(test stringify-1.0s0
-  (is (string= "1.0" (jzon:stringify 1.0s0))))
+(test stringify-1.0f0
+  (is (string= "1.0" (jzon:stringify 1.0f0))))
 
 (test stringify-1.0d0
   (is (string= "1.0" (jzon:stringify 1.0d0))))
 
 (test strigify-12.0d0
   (is (string= "12.0" (jzon:stringify 12.0d0))))
 
-(test stringify-123456.0s0
-  (is (string= "123456.0" (jzon:stringify 123456.0s0))))
+(test stringify-123456.0f0
+  (is (string= "123456.0" (jzon:stringify 123456.0f0))))
 
 (test stringify-1.2d0
   (is (string= "1.2" (jzon:stringify 1.2d0))))
 
-(test stringify-1.2s0
-  (is (string= "1.2" (jzon:stringify 1.2s0))))
+(test stringify-1.2f0
+  (is (string= "1.2" (jzon:stringify 1.2f0))))
 
 (test stringify-strings
   (is (string= "\"hello, world!\"" (jzon:stringify "hello, world!")))
@@ -1255,17 +1255,17 @@
     (let ((*print-base* 2))
       (is (string= "{\"10\":10}" (jzon:stringify (ph 10 10)))))))
 
-(test stringify-coerce-key-writes-single-floats-without-s0
+(test stringify-coerce-key-writes-single-floats-without-f0
   (with-standard-io-syntax
-    (is (string= "{\"1.5\":1.5}" (jzon:stringify (ph 1.5s0 1.5s0))))
+    (is (string= "{\"1.5\":1.5}" (jzon:stringify (ph 1.5f0 1.5f0))))
     (let ((*read-default-float-format* 'double-float))
-      (is (string= "{\"1.5\":1.5}" (jzon:stringify (ph 1.5s0 1.5s0)))))))
+      (is (string= "{\"1.5\":1.5}" (jzon:stringify (ph 1.5f0 1.5f0)))))))
 
 (test stringify-coerce-key-writes-double-floats-without-d0
   (with-standard-io-syntax
     (is (string= "{\"1.5\":1.5}" (jzon:stringify (ph 1.5d0 1.5d0))))
     (let ((*read-default-float-format* 'double-float))
-      (is (string= "{\"1.5\":1.5}" (jzon:stringify (ph 1.5s0 1.5s0)))))))
+      (is (string= "{\"1.5\":1.5}" (jzon:stringify (ph 1.5f0 1.5f0)))))))
 
 (test stringify-coerce-key-writes-rationals-like-floats
   (with-standard-io-syntax