Skip to content
Snippets Groups Projects
Commit 33a91f6a authored by Raymond Toy's avatar Raymond Toy
Browse files

Add tests for CLEAR-OUTPUT.

parent b6373368
No related branches found
No related tags found
No related merge requests found
;;;; -*- Lisp -*-
(defpackage fd-streams-tests
(:use #:common-lisp #:lisp-unit))
(in-package #:fd-streams-tests)
(defparameter *test-path*
(merge-pathnames (make-pathname :name :unspecific :type :unspecific
:version :unspecific)
*load-truename*)
"Directory for temporary test files.")
(defparameter *test-file*
(merge-pathnames #p"test-data.tmp" *test-path*))
(eval-when (:load-toplevel)
(ensure-directories-exist *test-path* :verbose t))
(define-test clear-output-1
(:tag :trac)
(assert-eql
0
(unwind-protect
(let ((s (open *test-file*
:direction :output
:if-exists :supersede)))
;; Write a character to the (fully buffered) output
;; stream. Clear the output and close the file. Nothing
;; should have been written to the file.
(write-char #\a s)
(clear-output s)
(close s)
(setf s (open *test-file*))
(file-length s))
(delete-file *test-file*))))
;;;; -*- Lisp -*-
(require :gray-streams)
(defpackage gray-streams-tests
(:use #:common-lisp #:lisp-unit))
(in-package #:gray-streams-tests)
(defparameter *test-path*
(merge-pathnames (make-pathname :name :unspecific :type :unspecific
:version :unspecific)
*load-truename*)
"Directory for temporary test files.")
(defparameter *test-file*
(merge-pathnames #p"test-data.tmp" *test-path*))
(eval-when (:load-toplevel)
(ensure-directories-exist *test-path* :verbose t))
(define-test clear-output-1
(:tag :trac)
;; Create a Gray stream and make sure that clear-output works.
(assert-eql
0
(unwind-protect
(let ((s (open *test-file*
:direction :output
:if-exists :supersede
:class 'lisp::character-output-stream)))
(write-char #\a s)
(clear-output s)
(close s)
(setf s (open *test-file*))
(file-length s))
(delete-file *test-file*))))
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment