with-standard-io-syntax.lsp 3.22 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Feb 23 05:12:13 2004
;;;; Contains: Tests of WITH-STANDARD-IO-SYNTAX

(in-package :cl-test)

(deftest with-standard-io-syntax.1
  (let ((*package* (find-package :cl-test)))
    (with-standard-io-syntax
     (eqlt *package* (find-package "CL-USER"))))
  t)

(deftest with-standard-io-syntax.2
  (let ((*print-array* nil))
    (with-standard-io-syntax *print-array*))
  t)

(deftest with-standard-io-syntax.3
  (let ((*print-base* 8))
    (with-standard-io-syntax *print-base*))
  10)

(deftest with-standard-io-syntax.4
  (let ((*print-case* :downcase))
    (with-standard-io-syntax *print-case*))
  :upcase)

(deftest with-standard-io-syntax.5
  (let ((*print-circle* t))
    (with-standard-io-syntax *print-circle*))
  nil)

(deftest with-standard-io-syntax.6
  (let ((*print-escape* nil))
    (with-standard-io-syntax *print-escape*))
  t)

(deftest with-standard-io-syntax.7
  (let ((*print-gensym* nil))
    (with-standard-io-syntax *print-gensym*))
  t)

(deftest with-standard-io-syntax.8
  (let ((*print-length* 100))
    (with-standard-io-syntax *print-length*))
  nil)

(deftest with-standard-io-syntax.9
  (let ((*print-level* 100))
    (with-standard-io-syntax *print-level*))
  nil)

(deftest with-standard-io-syntax.10
  (let ((*print-lines* 100))
    (with-standard-io-syntax *print-lines*))
  nil)

(deftest with-standard-io-syntax.11
  (let ((*print-miser-width* 100))
    (with-standard-io-syntax *print-miser-width*))
  nil)

(deftest with-standard-io-syntax.12
  (let ((*print-pretty* t))
    (with-standard-io-syntax *print-pretty*))
  nil)

(deftest with-standard-io-syntax.13
  (let ((*print-right-margin* 100))
    (with-standard-io-syntax *print-right-margin*))
  nil)

(deftest with-standard-io-syntax.14
  (let ((*read-base* 8))
    (with-standard-io-syntax *read-base*))
  10)

(deftest with-standard-io-syntax.15
  (let ((*read-default-float-format 'long-float))
    (with-standard-io-syntax *read-default-float-format*))
  single-float)

(deftest with-standard-io-syntax.16
  (let ((*read-eval* nil))
    (with-standard-io-syntax *read-eval*))
  t)

(deftest with-standard-io-syntax.17
  (let ((*read-suppress* t))
    (with-standard-io-syntax *read-suppress*))
  nil)

(deftest with-standard-io-syntax.18
  (with-standard-io-syntax (notnot-mv (readtablep *readtable*)))
  t)

pfdietz's avatar
pfdietz committed
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
(deftest with-standard-io-syntax.19
  (with-standard-io-syntax)
  nil)

(deftest with-standard-io-syntax.20
  (with-standard-io-syntax (values 'a 'b 'c))
  a b c)

(deftest with-standard-io-syntax.21
  (block done
    (tagbody
     (with-standard-io-syntax (go 10) 10 (return-from done :bad))
     10
     (return-from done :good)))
  :good)

(deftest with-standard-io-syntax.22
  (let ((i 3))
    (with-standard-io-syntax
     (incf i 10)
     (+ i 2)))
  15)
120

121 122 123 124 125 126 127 128 129
(deftest with-standard-io-syntax.23
  (let ((*print-pprint-dispatch* (copy-pprint-dispatch nil)))
    (set-pprint-dispatch 'symbol #'(lambda (stream obj)
                                     (declare (ignore obj))
                                     (write-string "FOO" stream)))
    (list (let ((*print-pretty* t)) (princ-to-string 'bar))
          (with-standard-io-syntax
            (let ((*print-pretty* t)) (princ-to-string 'bar)))))
  ("FOO" "BAR"))