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

« back to all changes in this revision

Viewing changes to ansi-tests/force-output.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:
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Wed Jan 28 06:41:46 2004
 
4
;;;; Contains: Tests of FORCE-OUTPUT
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest force-output.1
 
9
  (force-output)
 
10
  nil)
 
11
 
 
12
(deftest force-output.2
 
13
  (force-output t)
 
14
  nil)
 
15
 
 
16
(deftest force-output.3
 
17
  (force-output nil)
 
18
  nil)
 
19
 
 
20
(deftest force-output.4
 
21
  (loop for s in (list *debug-io* *error-output* *query-io*
 
22
                       *standard-output* *trace-output* *terminal-io*)
 
23
        for results = (multiple-value-list (force-output s))
 
24
        unless (equal results '(nil))
 
25
        collect s)
 
26
  nil)
 
27
 
 
28
(deftest force-output.5
 
29
  (let ((os (make-string-output-stream)))
 
30
    (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "")
 
31
                                              os)))
 
32
      (force-output t)))
 
33
  nil)
 
34
 
 
35
(deftest force-output.6
 
36
  (let ((*standard-output* (make-string-output-stream)))
 
37
    (force-output nil))
 
38
  nil)
 
39
 
 
40
 
 
41
;;; Error tests
 
42
 
 
43
(deftest force-output.error.1
 
44
  (signals-error (force-output nil nil) program-error)
 
45
  t)
 
46
 
 
47
(deftest force-output.error.2
 
48
  (signals-error (force-output t nil) program-error)
 
49
  t)
 
50
 
 
51
(deftest force-output.error.3
 
52
  (loop for x in *mini-universe*
 
53
        unless (or (member x '(nil t))
 
54
                   (typep x 'stream)
 
55
                   (equalt
 
56
                    (eval `(multiple-value-list
 
57
                            (signals-error (force-output ',x) type-error)))
 
58
                    '(t)))
 
59
        collect x)
 
60
  nil)
 
61