print-structure.lsp 1.49 KB
Newer Older
pfdietz's avatar
pfdietz committed
1
2
3
4
5
6
7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed May 26 22:19:52 2004
;;;; Contains: Printing tests for structures

(in-package :cl-test)

8

pfdietz's avatar
pfdietz committed
9
10
11
12
13
14
(defstruct print-struct-1
  foo bar)

(deftest print-structure.1
  (let ((s (make-print-struct-1 :foo 1 :bar 2)))
    (with-standard-io-syntax
Michał Herda's avatar
Michał Herda committed
15
16
17
18
      (let* ((*package* (find-package "CL-TEST"))
             (*tst-pkg* *package*)
             (*kwd-pkg* (find-package "KEYWORD")))
        (let ((str (write-to-string s :readably nil :case :upcase :escape nil)))
sds's avatar
sds committed
19
20
21
22
23
         (assert (string= (subseq str 0 3) "#S("))
         (let ((vals (read-from-string (subseq str 2))))
           (assert (listp vals))
           (assert (= (length vals) 5))
           (assert (eq (car vals) 'print-struct-1))
24
25
           (assert (symbolp (second vals)))
           (assert (symbolp (fourth vals)))
26
           (assert (eql *tst-pkg* (symbol-package (first vals))))
27
28
           (assert (eql *kwd-pkg* (symbol-package (second vals))))
           (assert (eql *kwd-pkg* (symbol-package (fourth vals))))
sds's avatar
sds committed
29
           (cond
30
31
32
33
            ((string= (symbol-name (second vals)) "FOO")
             (assert (string= (symbol-name (fourth vals)) "BAR"))
             (assert (= (third vals) 1))
             (assert (= (fifth vals) 2)))
sds's avatar
sds committed
34
            (t
35
36
37
38
             (assert (string= (symbol-name (second vals)) "BAR"))
             (assert (string= (symbol-name (fourth vals)) "FOO"))
             (assert (= (third vals) 2))
             (assert (= (fifth vals) 1))))
sds's avatar
sds committed
39
           nil)))))
pfdietz's avatar
pfdietz committed
40
  nil)