Commit a698a9ad authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

print-structure: check if slots are keywords

CLHS (Sharpsign S)
parent 5930ab86
...@@ -13,24 +13,27 @@ ...@@ -13,24 +13,27 @@
(deftest print-structure.1 (deftest print-structure.1
(let ((s (make-print-struct-1 :foo 1 :bar 2))) (let ((s (make-print-struct-1 :foo 1 :bar 2)))
(with-standard-io-syntax (with-standard-io-syntax
(let ((*package* (find-package "CL-TEST"))) (let ((*package* (find-package "CL-TEST"))
(*kwd-pkg* (find-package "KEYWORD")))
(let ((str (write-to-string s :readably nil :case :upcase :escape nil))) (let ((str (write-to-string s :readably nil :case :upcase :escape nil)))
(assert (string= (subseq str 0 3) "#S(")) (assert (string= (subseq str 0 3) "#S("))
(let ((vals (read-from-string (subseq str 2)))) (let ((vals (read-from-string (subseq str 2))))
(assert (listp vals)) (assert (listp vals))
(assert (= (length vals) 5)) (assert (= (length vals) 5))
(assert (eq (car vals) 'print-struct-1)) (assert (eq (car vals) 'print-struct-1))
(assert (symbolp (cadr vals))) (assert (symbolp (second vals)))
(assert (symbolp (cadddr vals))) (assert (symbolp (fourth vals)))
(assert (eql *kwd-pkg* (symbol-package (second vals))))
(assert (eql *kwd-pkg* (symbol-package (fourth vals))))
(cond (cond
((string= (symbol-name (cadr vals)) "FOO") ((string= (symbol-name (second vals)) "FOO")
(assert (string= (symbol-name (cadddr vals)) "BAR")) (assert (string= (symbol-name (fourth vals)) "BAR"))
(assert (= (caddr vals) 1)) (assert (= (third vals) 1))
(assert (= (car (cddddr vals)) 2))) (assert (= (fifth vals) 2)))
(t (t
(assert (string= (symbol-name (cadr vals)) "BAR")) (assert (string= (symbol-name (second vals)) "BAR"))
(assert (string= (symbol-name (cadddr vals)) "FOO")) (assert (string= (symbol-name (fourth vals)) "FOO"))
(assert (= (caddr vals) 2)) (assert (= (third vals) 2))
(assert (= (car (cddddr vals)) 1)))) (assert (= (fifth vals) 1))))
nil))))) nil)))))
nil) nil)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment