← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/print-structure.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/print-structure.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Wed May 26 22:19:52 2004
 
4
;;;; Contains: Printing tests for structures
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "printer-aux.lsp")
 
9
 
 
10
(defstruct print-struct-1
 
11
  foo bar)
 
12
 
 
13
(deftest print-structure.1
 
14
  (let ((s (make-print-struct-1 :foo 1 :bar 2)))
 
15
    (with-standard-io-syntax
 
16
     (let ((*package* (find-package "CL-TEST")))
 
17
       (let ((str (write-to-string s :readably nil :case :upcase :escape nil)))
 
18
         (assert (string= (subseq str 0 3) "#S("))
 
19
         (let ((vals (read-from-string (subseq str 2))))
 
20
           (assert (listp vals))
 
21
           (assert (= (length vals) 5))
 
22
           (assert (eq (car vals) 'print-struct-1))
 
23
           (assert (symbolp (cadr vals)))
 
24
           (assert (symbolp (cadddr vals)))
 
25
           (cond
 
26
            ((string= (symbol-name (cadr vals)) "FOO")
 
27
             (assert (string= (symbol-name (cadddr vals)) "BAR"))
 
28
             (assert (= (caddr vals) 1))
 
29
             (assert (= (car (cddddr vals)) 2)))
 
30
            (t
 
31
             (assert (string= (symbol-name (cadr vals)) "BAR"))
 
32
             (assert (string= (symbol-name (cadddr vals)) "FOO"))
 
33
             (assert (= (caddr vals) 2))
 
34
             (assert (= (car (cddddr vals)) 1))))
 
35
           nil)))))
 
36
  nil)