--- a/.TODO.done Sat Aug 29 23:57:54 2020 -0400
+++ b/.TODO.done Sun Aug 30 00:22:27 2020 -0400
@@ -1,5 +1,6 @@
Add read/print disabling mechanism | id:1268bf0b10c13aec23aafbd8f5e236db1e485fa5
Fix :allow-print and :allow-read to set t when removing them during class redef. | id:21cce1bed829a138de33b33e3ad3219f7888be04
+Input wrapping. | id:7bc7f71a7dd85e13efde40b5ea2a5b6bfe13cf58
Add basic wrapper definition | id:861f048b3b69079dedf8779be1cb73c05e6fc732
Optimize discarding | id:93105ef9d21d33bfb10c67fcac36bc60434d3fb4
Add after-read and before-print functions | id:9f982ca45b68d644159e0c64f0dc1b185f72a2f8
--- a/TODO Sat Aug 29 23:57:54 2020 -0400
+++ b/TODO Sun Aug 30 00:22:27 2020 -0400
@@ -1,6 +1,5 @@
Indentation. | id:0184922ad2c249da5361f439f6449fadcb27d43c
Clean up error hierarchy | id:3d3efa4af649474151661a9d294080ab24e22ff7
-Input wrapping. | id:7bc7f71a7dd85e13efde40b5ea2a5b6bfe13cf58
Fuzz against other JSON implementations | id:ccfe488e219c9454228a0510c61f8c59946e5875
Ensure slots are coalesced properly. | id:d800e6516a5bf5f8ce843f442956078e7a1b672e
Add more MOP-based tests (including errors). | id:df727baeb41bad02c7d79b92f98c24c8a28ca772
--- a/docs/api.lisp Sat Aug 29 23:57:54 2020 -0400
+++ b/docs/api.lisp Sun Aug 30 00:22:27 2020 -0400
@@ -21,7 +21,7 @@
(d-api:draw-class-hierarchy
"docs/static/errors.svg"
'(jarl::json-error
- jarl::json-parsing-error
+ jarl::json-reading-error
jarl::json-limit-exceeded-error
jarl::json-size-limit-exceeded-error
jarl::json-depth-limit-exceeded-error)
--- a/src/basic.lisp Sat Aug 29 23:57:54 2020 -0400
+++ b/src/basic.lisp Sun Aug 30 00:22:27 2020 -0400
@@ -4,7 +4,7 @@
(defparameter *read-size-limit* (expt 2 30)
"The maximum number of characters to read in a single `jarl:read` call.
- If more than this number of characters would have to be read to finish parsing
+ If more than this number of characters would have to be read to finish reading
a single object, a `json-size-limit-exceeded-error` will be signaled.
If both the size and depth limits are exceeded by exactly the same character,
@@ -13,7 +13,7 @@
(defparameter *read-depth-limit* 100
"The maximum depth of nested objects and vectors to allow in a single `jarl:read` call.
- If parsing a single object would require descending into more than this number
+ If reading a single object would require descending into more than this number
of JSON objects and/or arrays, a `json-depth-limit-exceeded-error` error will
be signaled.
@@ -21,7 +21,7 @@
it is unspecified which of the two errors will be signaled.")
-(defstruct input
+(defstruct (input (:constructor make-input%))
(stream nil :type stream)
(line 1 :type (and fixnum (integer 0)))
(column 0 :type (and fixnum (integer 0)))
@@ -31,6 +31,25 @@
(size-limit *read-size-limit* :type (and fixnum (integer 0)))
(string-buffer nil :type (or null stream)))
+(defun ensure-stream (stream-or-string)
+ (etypecase stream-or-string
+ (stream stream-or-string)
+ (string (make-string-input-stream stream-or-string))))
+
+(defun make-input (stream-or-string)
+ (make-input% :stream (ensure-stream stream-or-string)))
+
+(defun reset-limits (input)
+ (setf (input-depth input) 0
+ (input-size input) 0
+ (input-depth-limit input) *read-depth-limit*
+ (input-size-limit input) *read-size-limit*))
+
+(defun reset-position (input)
+ (setf (input-line input) 0
+ (input-column input) 0))
+
+
(defun p (input &optional (eof :eof)) ; peek
(declare (type input input)
(optimize (speed 3) (safety 1) (debug 1)))
@@ -60,23 +79,23 @@
((line :accessor line :initarg :line)
(column :accessor column :initarg :column)))
-(define-condition json-parsing-error (json-error)
+(define-condition json-reading-error (json-error)
((class-designator :accessor class-designator :initarg :class-designator)
(message :accessor message :initarg :message))
(:report
(lambda (c stream)
- (format stream "Error parsing JSON~@[ into ~S~] at line ~D column ~D: ~A"
+ (format stream "Error reading JSON~@[ into ~S~] at line ~D column ~D: ~A"
(class-designator c)
(line c)
(column c)
(message c)))))
-(define-condition json-limit-exceeded-error (json-parsing-error)
+(define-condition json-limit-exceeded-error (json-reading-error)
((limit :accessor limit :initarg :limit)
(limit-name :allocation :class))
(:report
(lambda (c stream)
- (format stream "~:(~A~) limit (~D) exceeded while parsing JSON at line ~D column ~D."
+ (format stream "~:(~A~) limit (~D) exceeded while reading JSON at line ~D column ~D."
(slot-value c 'limit-name)
(limit c)
(line c)
@@ -90,7 +109,7 @@
(defun e (class input format-string &rest args) ; error
- (error 'json-parsing-error
+ (error 'json-reading-error
:class-designator class
:line (input-line input)
:column (input-column input)
@@ -128,7 +147,7 @@
(loop :for next :across remaining-characters
:for char = (r input)
:unless (eql next char)
- :do (e 'keyword input "expected ~S when parsing ~S but got ~S" next literal char))
+ :do (e 'keyword input "expected ~S when reading ~S but got ~S" next literal char))
literal)
(defun parse-hex-digit (input)
@@ -227,6 +246,7 @@
(defmethod read% ((class (eql 'keyword)) contained-class input)
+ (declare (ignore contained-class))
(let ((ch (r input)))
(case ch
(#\t (parse-literal input :true "rue"))
@@ -234,6 +254,7 @@
(t (e 'keyword input "expected ~S or ~S but got ~S" #\t #\f ch)))))
(defmethod read% ((class (eql 'null)) contained-class input)
+ (declare (ignore contained-class))
(let ((ch (r input)))
(if (eql ch #\n)
(parse-literal input nil "ull")
@@ -265,6 +286,7 @@
'vector)))
(defmethod read% ((class (eql 'string)) contained-class input)
+ (declare (ignore contained-class))
(let ((ch (r input)))
(unless (eql ch #\")
(e 'string input "expected opening ~S but got ~S" #\" ch)))
@@ -294,8 +316,8 @@
:with c = (car contained-class)
:with cc = (cadr contained-class)
:for name = (read% 'string nil input)
- :for sep = (parse-kv-separator 'hash-table input)
- :for value = (progn (skip-whitespace input)
+ :for value = (progn (parse-kv-separator 'hash-table input)
+ (skip-whitespace input)
(read% c cc input))
:do (progn
(setf (gethash name result) value)
@@ -308,6 +330,7 @@
result))
(defmethod read% ((class (eql 'number)) contained-class input)
+ (declare (ignore contained-class))
(let ((ch (p input)))
(unless (member ch '(#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
(r input) ; chomp to ensure accurate column count
@@ -321,6 +344,7 @@
(t (read% (first contained-class) (second contained-class) input))))
(defmethod read% ((class (eql t)) contained-class input)
+ (declare (ignore contained-class))
(skip-whitespace input)
(case (p input)
(:eof (r input) (e 't input "got ~S" :eof))
@@ -416,21 +440,19 @@
(hash-table '(hash-table (t)))
(t (list class-designator)))))))
-(defun ensure-stream (stream-or-string)
- (etypecase stream-or-string
- (stream stream-or-string)
- (string (make-string-input-stream stream-or-string))))
-(defun read (class-designator stream-or-string &optional (eof-error-p t) eof)
- (let ((input (make-input :stream (ensure-stream stream-or-string))))
- (skip-whitespace input)
- (if (eql :eof (p input))
- (if eof-error-p
- (error 'end-of-file)
- eof)
- (destructuring-bind (class &optional contained)
- (canonicalize-class-designator class-designator)
- (read% class contained input)))))
+(defun read (class-designator input &optional (eof-error-p t) eof)
+ (etypecase input
+ (input (reset-limits input))
+ ((or stream string) (setf input (make-input input))))
+ (skip-whitespace input)
+ (if (eql :eof (p input))
+ (if eof-error-p
+ (error 'end-of-file)
+ eof)
+ (destructuring-bind (class &optional contained)
+ (canonicalize-class-designator class-designator)
+ (read% class contained input))))
(defun print (object &optional (stream *standard-output*))
(let ((*read-default-float-format* 'double-float)
--- a/src/package.lisp Sat Aug 29 23:57:54 2020 -0400
+++ b/src/package.lisp Sun Aug 30 00:22:27 2020 -0400
@@ -4,7 +4,7 @@
(:export
:read :print
- :json-parsing-error :line :column
+ :json-reading-error :line :column
:json-class
:lisp-case-to-snake-case
--- a/test/tests.lisp Sat Aug 29 23:57:54 2020 -0400
+++ b/test/tests.lisp Sun Aug 30 00:22:27 2020 -0400
@@ -83,9 +83,9 @@
(handler-case
(progn
(jarl:read class string)
- (error "Should have signaled a json-parsing-error when parsing ~S but didn't."
+ (error "Should have signaled a json-reading-error when reading ~S but didn't."
class))
- (jarl::json-parsing-error (e)
+ (jarl::json-reading-error (e)
(is (equal (list class line col)
(list class (jarl:line e) (jarl:column e))))))))
@@ -323,7 +323,11 @@
(signals jarl::json-size-limit-exceeded-error (jarl:read t " null"))
(signals jarl::json-size-limit-exceeded-error (jarl:read t "\"foobarbaz"))
(signals jarl::json-size-limit-exceeded-error (jarl:read t "[[[[[[[[[[[[[[[[[[["))
- (signals jarl::json-size-limit-exceeded-error (jarl:read nil "[1, 2, 3 ]"))))
+ (signals jarl::json-size-limit-exceeded-error (jarl:read nil "[1, 2, 3 ]"))
+ (let ((input (jarl::make-input "123456789[][1,2,3,4,5,6,7,8,9]")))
+ (is (same 123456789 (jarl:read t input)))
+ (is (same (v) (jarl:read t input)))
+ (signals jarl::json-size-limit-exceeded-error (jarl:read t input)))))
(define-test depth-limit
;; TODO Add some more of these.
@@ -332,7 +336,10 @@
(signals jarl::json-depth-limit-exceeded-error (jarl:read t "[[[[1]]]]"))
(signals jarl::json-depth-limit-exceeded-error (jarl:read t (json "[{'foo': [[1]]}]")))
(signals jarl::json-depth-limit-exceeded-error (jarl:read nil "[[[[1]]]]"))
- (signals jarl::json-depth-limit-exceeded-error (jarl:read nil (json "[{'foo': [[1]]}]")))))
+ (signals jarl::json-depth-limit-exceeded-error (jarl:read nil (json "[{'foo': [[1]]}]")))
+ (let ((input (jarl::make-input "[[[]]][[[[]]]]")))
+ (is (same (v (v (v))) (jarl:read t input)))
+ (signals jarl::json-depth-limit-exceeded-error (jarl:read t input))) ))
;;;; MOP ----------------------------------------------------------------------
@@ -579,6 +586,19 @@
(signals error (jarl:read 'us-err "{'id':1, 'foo': 'bar', 'meow': 'wow'}")))
+;;;; Passing Input ------------------------------------------------------------
+(define-test passing-input
+ (let ((input (jarl::make-input (json "[1,2] 99 [} {}"))))
+ (is (same (v 1 2) (jarl:read '(vector number) input)))
+ (is (same 99 (jarl:read 'number input)))
+ (handler-case
+ (progn (jarl:read 'vector input)
+ (error "Should have signaled an error, but did not."))
+ (jarl::json-reading-error (e)
+ (is (= 1 (jarl::line e)))
+ (is (= 13 (jarl::column e)))))))
+
+
;;;; Fuzz Utilities -----------------------------------------------------------
(defparameter *basic-chars*
" abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_,'[]{}+=")