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.

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)))
diff --git a/stream.c b/stream.c
index 34509f87..2fdd5e0d 100644
--- a/stream.c
+++ b/stream.c
@@ -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))))
diff --git a/txr.1 b/txr.1
index a0d9773d..9de10070 100644
--- a/txr.1
+++ b/txr.1
@@ -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.