Skip to content

Commit

Permalink
Merge branch 'master' into array-as-vector
Browse files Browse the repository at this point in the history
  • Loading branch information
@libre-man
libre-man committed Apr 23, 2020
2 parents 74c48c2 + 17df8ed commit 084e57f
Show file tree
Hide file tree
Showing 6 changed files with 97 additions and 26 deletions.
40 changes: 31 additions & 9 deletions src/decode.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -180,6 +180,9 @@
unicode-chars)))
(advance*))))
(read-unicode-escape-sequence ()
"Returns a pair like (char . is-surrogate-p) where
is-surrogate-p is `t' if char is a surrogate unicode symbol and
`nil' otherwise."
(advance*)
(let ((char-code (parse-integer (subseq string (pos) (+ (pos) 4))
:radix 16)))
Expand Down Expand Up @@ -232,7 +235,7 @@
(#\u (if unescape-unicode-escape-sequence
(let ((pair (pop unicode-chars)))
(if (cdr pair)
(incf index 11)
(incf index 10)
(incf index 4))
(car pair))
#\u))
Expand Down Expand Up @@ -283,7 +286,8 @@
:eof
(return-from read-number))
(bind (num-str (skip-while integer-char-p))
(let ((num (the fixnum (parse-integer num-str))))
(let ((num (the fixnum (parse-integer num-str)))
(neg (the boolean (char= #\- (schar num-str 0)))))
(when (with-allowed-last-character ()
(skip? #\.))
(setq num
Expand All @@ -292,13 +296,12 @@
(bind (rest-num-str (skip-while integer-char-p))
(let* ((rest-num (parse-integer rest-num-str))
(digits-len (the fixnum (- (pos) rest-start)))
(bits-len (the fixnum (+ digits-len (length num-str)))))
(bits-len (the fixnum (+ digits-len (length num-str) (if neg -1 0))))
(significand (convert-significand digits-len bits-len rest-num)))
(return
(+ num
(coerce (/ rest-num (expt 10 digits-len))
(if (< 8 bits-len)
'double-float
'single-float))))))))))
(if neg
(- num significand)
(+ num significand)))))))))
(when (with-allowed-last-character ()
(skip? #\e #\E))
(setq num
Expand All @@ -310,7 +313,26 @@
(if (< exp-num 0)
(float (expt 10 exp-num))
(expt 10 exp-num)))))))))
(return-from read-number (the fixnum num)))))))
(return-from read-number (the fixnum num))))))
(convert-significand (digits-len bits-len rest-num)
(cond ((> digits-len 20)
(coerce (/ rest-num (expt 10 digits-len))
(if (< 8 bits-len)
'double-float
'single-float)))
((< 8 bits-len)
(* rest-num
(aref #.(coerce (loop for i from 0 to 20
collect (coerce (expt 10 (- i))
'double-float))
'simple-vector)
digits-len)))
((* rest-num
(aref #.(coerce (loop for i from 0 to 8
collect (coerce (expt 10 (- i))
'single-float))
'simple-vector)
digits-len))))))
(declare (inline read-object
read-string
read-unicode-escape-sequence
Expand Down
4 changes: 3 additions & 1 deletion src/encode.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -224,7 +224,9 @@
(defmethod %to-json ((list list))
(cond
((and (eq *from* :alist)
(association-list-p list))
(association-list-p list)
;; check if is alist key atom.
(atom (caar list)))
(alist-to-json list))
((and (eq *from* :jsown)
(eq (car list) :obj))
Expand Down
13 changes: 8 additions & 5 deletions src/helper.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,12 +104,15 @@

(defun replace-form-with-placeholders (form)
(let ((placeholders (make-hash-table :test #'equal)))
(flet ((genstr () (symbol-name (gensym *compile-encoder-prefix*))))
(flet ((genstr () (symbol-name (gensym *compile-encoder-prefix*)))
(swap (object placeholder)
(setf (gethash placeholder placeholders) object)
placeholder))
(labels ((sub (object)
(etypecase object
(string object)
(keyword object)
(symbol (setf (gethash object placeholders) (genstr)))
(symbol (swap object (genstr)))
(cons (let ((sym-name (symbol-name (car object))))
(cond
((equal sym-name "LIST*")
Expand All @@ -118,7 +121,7 @@
(cons 'list (mapcar #'sub (cdr object))))
((equal sym-name "QUOTE")
object)
(t (setf (gethash object placeholders) (genstr)))))))))
(t (swap object (genstr)))))))))
(values (sub form) placeholders)))))

@doc
Expand All @@ -142,13 +145,13 @@
when (stringp item)
do (multiple-value-bind (start end)
(scan (with-output-to-string*
(%to-json ,val))
(%to-json ,key))
item)
(when (and start end)
(setq matched-p t)
(setq item
(list (subseq item 0 start)
',key
',val
(subseq item end)))))
if matched-p
nconc (ensure-list item)
Expand Down
29 changes: 26 additions & 3 deletions t/decode.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -161,6 +161,15 @@
(parse-test 0.1
"with float.")

(parse-test -0.0
"with negative float zero.")

(parse-test -0.1
"with negative float.")

(parse-test -9.9
"with negative float.")

(parse-test *upper-exponent*
"with E.")

Expand Down Expand Up @@ -290,10 +299,15 @@
(is (parse "\"\\u30b8\\u30e7\\u30ca\\u30b5\\u30f3\"")
"ジョナサン"
"without surrogate pair.")
#+(or :sbcl :clisp)
#+(or :sbcl :clisp :ccl)
(is (parse "\"\\uD840\\uDC0B\"")
"𠀋"
"with surrogate pair."))
"with surrogate pair.")
(is (parse "\"\\uD83D\\uDE3E\\uD83D\\uDD2A\"")
(concatenate 'string
(parse "\"\\uD83D\\uDE3E\"")
(parse "\"\\uD83D\\uDD2A\""))
"surrogate pairs should be parsed equally when they follow together and separate from each other."))

(subtest "NIL"
(is (parse "\"\\u30b8\\u30e7\\u30ca\\u30b5\\u30f3\""
Expand Down Expand Up @@ -329,6 +343,15 @@
"Can parse double-float")
(is (parse "35.659108")
35.659108
"Can parse single-float"))
"Can parse single-float")
(is (parse "-35.65910807942215")
-35.65910807942215d0
"Can parse negative double-float")
(is (parse "-139.70372892916203")
-139.70372892916203d0
"Can parse negative double-float")
(is (parse "-35.659108")
-35.659107
"Can parse negative single-float"))

(finalize)
24 changes: 23 additions & 1 deletion t/encode.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@

(diag "jonathan-test.encode")

(plan 26)
(plan 27)

(subtest "with-object"
(is-print
Expand Down Expand Up @@ -147,10 +147,32 @@
"{\"Rudolph\":\"Miller\"}"
":from :alist.")

(subtest "nested alist with array value"
(let ((a0 '(("a" . (("aa" . 1)))))
(a1 '(("a" . ((("aa" . 1))))))
(a2 '(("a" . ((("aa" . 1) ("bb" . 2))))))
(a3 '(("a" . ((("aa" . 1)) (("bb" . 2)))))))
(is (to-json a0 :from :alist)
"{\"a\":{\"aa\":1}}"
"value is alist")
(is (to-json a1 :from :alist)
"{\"a\":[{\"aa\":1}]}"
"value is array of alist")
(is (to-json a2 :from :alist)
"{\"a\":[{\"aa\":1,\"bb\":2}]}"
"value is array of alist")
(is (to-json a3 :from :alist)
"{\"a\":[{\"aa\":1},{\"bb\":2}]}"
"value is array of alists")))

(is (to-json '(:obj (:|Rudolph| . "Miller")) :from :jsown)
"{\"Rudolph\":\"Miller\"}"
":from :jsown.")

(is (let ((user "bob"))
(to-json (list :a user :b user)))
"{\"A\":\"bob\",\"B\":\"bob\"}")

(defclass user ()
((id :type integer :initarg :id)
(name :type string :initarg :name)))
Expand Down
13 changes: 6 additions & 7 deletions t/thread.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,16 +14,15 @@

(defparameter *cluster*
(legion:make-cluster 30
(lambda (worker)
(let ((val (legion:next-job worker)))
(handler-case
(lambda (val)
(handler-case
(assert (string= "{\"retry_count\":0,\"failed_at\":1481507440,\"queue\":\"default\",\"error_class\":\"COMMON-LISP::SIMPLE-ERROR\",\"error_message\":\"Some shit happened\",\"class\":\"WORKER::MY-WORKER\",\"args\":[140],\"jid\":\"xeeuh54pm4id\",\"created_at\":1481507440,\"enqueued_at\":1481507704}"
(jojo:to-json val :from :alist)))
(error (e)
(declare (ignore e))
(incf *failed-count*)))))))
(error (e)
(declare (ignore e))
(incf *failed-count*))))))

(legion:start-cluster *cluster*)
(legion:start *cluster*)

(dotimes (i 300)
(legion:add-job *cluster* '(("retry_count" . 0)
Expand Down

0 comments on commit 084e57f

Please sign in to comment.