59 lines
2.0 KiB
Scheme
59 lines
2.0 KiB
Scheme
(import r7rs)
|
|
(require-extension srfi-69 srfi-64 srfi-88 srfi-1)
|
|
;;(import (chicken port))
|
|
(include "../edn-impl.scm")
|
|
;; (run-hahn -o edn.wiki edn.scm edn-impl.scm)
|
|
|
|
(define s->k string->keyword)
|
|
|
|
(test-begin "EDN writing")
|
|
|
|
(test-equal (parse-entry keyword:) ":keyword")
|
|
(test-equal (parse-entry #t) "true")
|
|
(test-equal (parse-entry #f) "false")
|
|
(test-equal (parse-entry '()) "nil")
|
|
(test-equal (parse-entry #\a) "\\a")
|
|
(test-equal (parse-entry "String") "\"String\"")
|
|
(test-equal (parse-entry (cons edn/reader-tag: neat:)) "#neat")
|
|
|
|
(test-equal (list->edn parse-entry '(1 2 3 4)) "(1 2 3 4)")
|
|
(test-equal (vector->edn parse-entry #(a: b: c: d:)) "[:a :b :c :d]")
|
|
(test-equal
|
|
(let ((port (open-output-string)))
|
|
(write-edn port '((a: . "Hi")
|
|
(b: . i-am:)
|
|
(c: . (a list))))
|
|
(get-output-string port))
|
|
"{:a \"Hi\" :b :i-am :c (a list)}")
|
|
(test-end "EDN writing")
|
|
|
|
(test-begin "EDN reading")
|
|
(define (wifs str proc)
|
|
(call-with-port (open-input-string str) proc))
|
|
|
|
(test-equal (wifs "(:keyword)" read-edn) '(keyword:))
|
|
(test-equal (wifs "(123)" read-edn) '(123))
|
|
(test-equal (wifs "(\"Hello World!\")" read-edn) '("Hello World!"))
|
|
(test-equal (wifs "(false)" read-edn) '(#f))
|
|
(test-equal (wifs "(true)" read-edn) '(#t))
|
|
(test-equal (wifs "(:Hello \"World\" 1)" read-edn) '(Hello: "World" 1))
|
|
(test-equal (wifs "[:a :b :c :d]" read-edn) #(a: b: c: d:))
|
|
(test-assert
|
|
((lambda (a b)
|
|
(and (equal? (hash-table-ref b a:) "Hi")
|
|
(equal? (hash-table-ref b b:) i-am:)
|
|
(equal? (hash-table-ref b c:) `(a list))))
|
|
(alist->hash-table '((a: . "Hi") (b: . i-am:) (c: . (a list))))
|
|
(wifs "{:a \"Hi\" :b :i-am :c (a list)}" read-edn)))
|
|
(test-end "EDN reading")
|
|
|
|
(test-begin "Tag handling")
|
|
(test-equal (wifs "(1 2 #_ 3 4)" read-edn) '(1 2 4))
|
|
|
|
(set! tag-handlers (cons (cons keywordify:
|
|
(lambda (input)
|
|
(string->keyword (symbol->string input))))
|
|
tag-handlers))
|
|
(test-equal (wifs "(asdf #keywordify qwertz)" read-edn) '(asdf qwertz:))
|
|
(test-end "Tag handling")
|