diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-05-31 23:21:20 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-05-31 23:21:20 -0700 |
commit | f311b6ca089954675e745ad9212209ca8cf23be2 (patch) | |
tree | db61d4698f4485b87f0e5cc19b2da300acf8e14a | |
parent | 5d02e6e736d419c0abc271b6049814598cdc3cb9 (diff) | |
download | txr-f311b6ca089954675e745ad9212209ca8cf23be2.tar.gz txr-f311b6ca089954675e745ad9212209ca8cf23be2.tar.bz2 txr-f311b6ca089954675e745ad9212209ca8cf23be2.zip |
json: wrap up: test cases, fixes, tweaks.
* /share/txr/stdlib/getput.tl (get-jsons): If the s parameter
is a string, convert it to a byte input stream so that.
(put-jsons): Add missing t return value.
(file-put-json, file-append-json, file-put-jsons,
file-append-jsons, command-put-jsons, command-put-jsons): Add
missing object argument to all these functions, and a missing
"w" open-file mode to several of them.
* stream.c (mkstemp_wrap): Calculate length of suff the
defaulted argument, not the raw suffix argument.
* test/010/json.tl: New file, providing tests that touch every
area of the new JSON functionality.
* tests/common.tl (mstest, with-temp-file): New macros.
* txr.1: Document that get-jsons takes a source which could be
a string.
-rw-r--r-- | share/txr/stdlib/getput.tl | 33 | ||||
-rw-r--r-- | stream.c | 2 | ||||
-rw-r--r-- | tests/010/json.tl | 124 | ||||
-rw-r--r-- | tests/common.tl | 11 | ||||
-rw-r--r-- | txr.1 | 22 |
5 files changed, 169 insertions, 23 deletions
diff --git a/share/txr/stdlib/getput.tl b/share/txr/stdlib/getput.tl index 55d0f866..13ffba4b 100644 --- a/share/txr/stdlib/getput.tl +++ b/share/txr/stdlib/getput.tl @@ -46,6 +46,8 @@ b)) (defun get-jsons (: (s *stdin*)) + (when (stringp s) + (set s (make-string-byte-input-stream s))) (build (catch* (while t @@ -56,7 +58,8 @@ (defun put-jsons (list : (s *stdout*) flat-p) (each ((obj list)) - (put-jsonl obj s flat-p))) + (put-jsonl obj s flat-p)) + t) (defun file-get (name) (with-stream (s (open-file name)) @@ -117,25 +120,25 @@ (with-stream (s (open-file name)) (get-json s))) -(defun file-put-json (name : flat-p) - (with-stream (s (open-file name)) - (put-jsonl s flat-p))) +(defun file-put-json (name obj : flat-p) + (with-stream (s (open-file name "w")) + (put-jsonl obj s flat-p))) -(defun file-append-json (name : flat-p) +(defun file-append-json (name obj : flat-p) (with-stream (s (open-file name "a")) - (put-jsonl s flat-p))) + (put-jsonl obj s flat-p))) (defun file-get-jsons (name) (with-stream (s (open-file name)) (get-jsons s))) -(defun file-put-jsons (name : flat-p) - (with-stream (s (open-file name)) - (put-jsons s flat-p))) +(defun file-put-jsons (name seq : flat-p) + (with-stream (s (open-file name "w")) + (put-jsons seq s flat-p))) -(defun file-append-jsons (name : flat-p) +(defun file-append-jsons (name seq : flat-p) (with-stream (s (open-file name "a")) - (put-jsons s flat-p))) + (put-jsons s seq flat-p))) (defun command-get (cmd) (with-stream (s (open-command cmd)) @@ -172,14 +175,14 @@ (with-stream (s (open-command cmd)) (get-json s))) -(defun command-put-json (cmd : flat-p) +(defun command-put-json (cmd obj : flat-p) (with-stream (s (open-command cmd "w")) - (put-jsonl s flat-p))) + (put-jsonl obj s flat-p))) (defun command-get-jsons (cmd) (with-stream (s (open-command cmd)) (get-jsons s))) -(defun command-put-jsons (cmd : flat-p) +(defun command-put-jsons (cmd seq : flat-p) (with-stream (s (open-command cmd "w")) - (put-jsons s flat-p))) + (put-jsons seq s flat-p))) @@ -4976,7 +4976,7 @@ val mkstemp_wrap(val prefix, val suffix) val self = lit("mkstemp"); val suff = default_arg(suffix, null_string); val template = scat3(prefix, lit("XXXXXX"), suff); - cnum slen = c_num(length(suffix), self); + cnum slen = c_num(length(suff), self); char *tmpl = utf8_dup_to(c_str(template)); val name; int fd; diff --git a/tests/010/json.tl b/tests/010/json.tl new file mode 100644 index 00000000..68544f07 --- /dev/null +++ b/tests/010/json.tl @@ -0,0 +1,124 @@ +(load "../common") + +(mtest + #J0 0.0 + #J"abc" "abc" + #Jtrue t + #Jfalse nil + #Jnull null) + +(mtest + #J1 1.0 + #J 1 1.0 + #J123 123.0 + #J0.123 0.123 + #J1.123 1.123 + #J1E3 1000.0 + #J1.1E3 1100.0 + #J1.1E+3 1100.0 + #J1.1E+03 1100.0 + #J1.1e3 1100.0 + #J1.1e+3 1100.0 + #J1.1e+03 1100.0) + +(mtest + #J"" "" + #J"\u0000" "\xdc00" + #J"\u0001" "\x1" + #J"\ud801\udc37" "\x10437" + #J"a\u0000b" "a\xdc00;b" + #J"a\u0001b" "a\x1;b" + #J"a\ud801\udc37b" "a\x10437;b" + #J"\b\t\n\f\r" "\b\t\n\f\r" + #J"\/\\\"" "/\\\"") + +(mtest + #J[] #() + #J[ ] #() + #J[ ] #() + #J [ ] #() + #J[null] #(null) + #J[false] #(nil) + #J[true] #(t) + #J["abc"] #("abc") + #J[1,2,3] #(1.0 2.0 3.0) + #J[ 1 , 2 , 3 ] #(1.0 2.0 3.0) + #J[[]] #(#()) + #J[[],[]] #(#() #()) + #J[ [] , [] ] #(#() #()) + #J[[1],[2],3] #(#(1.0) #(2.0) 3.0)) + +(mtest + #J{} #H(()) + #J{ } #H(()) + #J{ } #H(()) + #J { } #H(()) + #J{true:true} #H(() (t t))) + #J{ true : true } #H(() (t t)) + #J{ {} : {} } #H(() (#H(()) #H(()))) + #J{ "a" : 1.0 } #H(() (a 1.0)) + #J{ "a" : 1.0, "b" : [null] } #H(() (a 1.0) (b #(null))) + +(let ((*print-circle* t)) + (mstest + #J[#1="abc", #1#] "#(#1=\"abc\" #1#)" + #2=#J[1, #2#] "#1=#(1.0 #J#1#)" + #J#3=[1, #3#] "#1=#(1.0 #1#)" + #4=#J{#4#:#4#} "#1=#H(() (#2=#J#1# #2#))" + #J#5={#5#:#5#} "#1=#H(() (#1# #1#))") + + (let ((chash #J{"foo":#6="bar", "xyzzy":#6#})) + (mtest + [chash "xyzzy"] "bar" + (eq [chash "foo"] [chash "xyzzy"]) t))) + +(mtest + ^#J~(+ 1.0 1) #J2 + ^#J[1, ~(+ 2.0 2)] #J[1, 4] + ^#J[1, ~(+ 2.0 2), 3] #J[1, 4, 3] + (eval ^^#J~#(1.0 ,*(list 2.0 3.0) 4.0)) #J[1, 2, 3, 4] + ^#J[1, ~*(list 2.0 3.0), 4] #J[1, 2, 3, 4] + #J^[1, ~(+ 2.0 2)] #(1.0 4.0) + #J^[1, ~(+ 2.0 2), 3] #(1.0 4.0 3.0) + ^#J{~(join "abc" "def") : "ghi"} #J{"abcdef":"ghi"} + #J^{~(join "abc" "def") : "ghi"} #H(() ("abcdef" "ghi"))) + +;; get-json +(mtest + (get-json "0") 0.0 + (get-json "\"abc\"") "abc" + (get-json "true") t + (get-json "false") nil + (get-json "null") null) + +(test + (tojson #(1.0 "abc" t)) "[1,\"abc\",true]") + +(mtest + (get-jsons "") nil + (get-jsons "true") (t) + (get-jsons "1 1 [2] {3:4}") (1.0 1.0 #(2.0) #H(() (3.0 4.0)))) + +(mtest + (with-out-string-stream (s) (put-json nil s)) "false" + (with-out-string-stream (s) (put-jsons nil s)) "" + (with-out-string-stream (s) (put-jsons '(1.0 t nil) s)) "1\ntrue\nfalse\n") + +(with-temp-file (name s "json") + (mtest + (file-put-json name #(1.0 2.0 3.0)) t + (file-get-string name) "[1,2,3]\n" + (file-get-json name) #(1.0 2.0 3.0) + (file-append-json name #H(() ("a" t))) t + (file-get-string name) "[1,2,3]\n{\"a\":true}\n" + (file-get-jsons name) (#(1.0 2.0 3.0) + #H(() ("a" t))) + (file-put-jsons name '(1.0 t null)) t + (file-get-jsons name) (1.0 t null) + (file-get-string name) "1\ntrue\nnull\n" + (command-put-json `cat > @name` #(#() #())) t + (file-get-string name) "[[],[]]\n") + (command-get-json `cat @name`) #(#() #()) + (command-put-jsons `cat > @name` '(#() 1.0 nil)) t + (file-get-string name) "[]\n1\nfalse\n" + (command-get-jsons `cat @name`) '(#() 1.0 nil)) diff --git a/tests/common.tl b/tests/common.tl index 9f7e6eb3..f89d6ed8 100644 --- a/tests/common.tl +++ b/tests/common.tl @@ -26,6 +26,9 @@ (defmacro mtest (. pairs) ^(progn ,*(mapcar (op cons 'test) (tuples 2 pairs)))) +(defmacro mstest (. pairs) + ^(progn ,*(mapcar (op cons 'stest) (tuples 2 pairs)))) + (defun os-symbol () (if (ignerr (dlsym (dlopen "libandroid.so") "AAsset_close")) :android @@ -50,3 +53,11 @@ (let ,bindings (expand '(progn ,*body) ,env)))) (,invoke)))) + +(defmacro with-temp-file ((name-var stream-var prefix) . body) + ^(let* ((,stream-var (mkstemp ,prefix)) + (,name-var (stream-get-prop ,stream-var :name))) + (unwind-protect + (progn ,*body) + (close-stream ,stream-var) + (remove-path ,name-var)))) @@ -72213,24 +72213,32 @@ function returns .coNP Function @ get-jsons .synb -.mets (gut-jsons <> [ stream ]) +.mets (get-jsons <> [ source ]) .syne .desc The .meta get-jsons function reads zero or more JSON representations from -.meta stream +.meta source until an end-of-stream or error condition is encountered. +If +.meta source +is a character string, then the input takes place from a stream +created from the character string using +.codn make-string-byte-input-stream . +Otherwise, if +.meta source +is specified, it must be an input stream supporting byte input; +input takes place from that stream. If the +.meta source +argument is omitted, it defaults to +.codn *stdin* . + The objects are read as if by calls to .code get-json and accumulated into a list. -If the -.meta stream -argument is omitted, it defaults to -.codn *stdin* . - If the end-of-stream condition is read, then the list of accumulated objects is returned. If an error occurs, then an exception is thrown and the list of accumulated objects is not available. |