summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2023-12-19 19:32:28 -0800
committerKaz Kylheku <kaz@kylheku.com>2023-12-19 19:32:28 -0800
commitdaf60d254b0f47fcdd2dec4046a4e97476da9eee (patch)
treea7340760fa611c16ec048f4a35bbab0951c90845 /tests
parent5253d51f5139008cf86c24235e394b409fd82808 (diff)
downloadtxr-daf60d254b0f47fcdd2dec4046a4e97476da9eee.tar.gz
txr-daf60d254b0f47fcdd2dec4046a4e97476da9eee.tar.bz2
txr-daf60d254b0f47fcdd2dec4046a4e97476da9eee.zip
New functions: read-objects, file-get-objects, ...
* parser.c (read_objects_common): New static function, formed from read_objects_from-string. (read_objects_from_string): Now wrapper for read_objects_common. (read_objects): New function. * parser.h (read_objects): Declared. * eval.c (eval_init): Register read-objects intrinsic. * autoload.c (getput_set_entries): Add three new symbols: file-get-objects, file-put-objects and file-append-objects. * stdlib/getput.tl (put-objects): New system function. (file-get-objects, file-put-objects, file-append-objects): New functions. * txr.1: Documented. * tests/018/getput.tl: New file.
Diffstat (limited to 'tests')
-rw-r--r--tests/018/getput.tl33
1 files changed, 33 insertions, 0 deletions
diff --git a/tests/018/getput.tl b/tests/018/getput.tl
new file mode 100644
index 00000000..7e8e2be1
--- /dev/null
+++ b/tests/018/getput.tl
@@ -0,0 +1,33 @@
+(load "../common")
+
+(defvarl file "getput.data")
+
+(push-after-load (remove-path file))
+
+(file-put-objects file '(1 2.3 (a . b) "foo"))
+
+(test
+ (file-get-lines file) ("1" "2.3" "(a . b)" "\"foo\""))
+
+(file-append-objects file '(#(nil)))
+
+(mtest
+ (file-get-lines file) ("1" "2.3" "(a . b)" "\"foo\"" "#(nil)")
+ (file-get-objects file) (1 2.3 (a . b) "foo" #(nil)))
+
+(mtest
+ (read-objects "(a . b) #\\c") ((a . b) #\c)
+ (read-objects "(a") :error)
+
+(file-put-string file "(a")
+
+(mtest
+ (file-get file) :error
+ (file-get-objects file) :error)
+
+(let ((errors (with-out-string-stream (err)
+ (ignerr (file-get-objects file : err)))))
+ (mtest
+ (true (contains "syntax error" errors)) t
+ (true (contains "unterminated" errors)) t
+ (true (contains ":1" errors)) t))