Commit f621429f authored by pfdietz's avatar pfdietz

Enhance some error tests to include unsafe code.

parent 4ef6d8ef
......@@ -143,12 +143,12 @@
;; Need to add a LPN test
(deftest ensure-directories-exist.error.1
(signals-error
(signals-error-always
(ensure-directories-exist
(make-pathname :directory '(:relative :wild)
:defaults *default-pathname-defaults*))
file-error)
t)
t t)
(deftest ensure-directories-exist.error.2
(signals-error (ensure-directories-exist) program-error)
......
......@@ -66,28 +66,15 @@
t)
(deftest file-author.error.3
(signals-error
(signals-error-always
(file-author (make-pathname :name :wild :type "lsp"
:defaults *default-pathname-defaults*))
file-error)
t)
t t)
(deftest file-author.error.4
(signals-error
(signals-error-always
(file-author (make-pathname :name "file-author" :type :wild
:defaults *default-pathname-defaults*))
file-error)
t)
t t)
......@@ -65,15 +65,15 @@
t)
(deftest file-write-date.error.3
(signals-error
(signals-error-always
(file-write-date (make-pathname :name :wild :type "lsp"
:defaults *default-pathname-defaults*))
file-error)
t)
t t)
(deftest file-write-date.error.4
(signals-error
(signals-error-always
(file-write-date (make-pathname :name "file-write-date" :type :wild
:defaults *default-pathname-defaults*))
file-error)
t)
t t)
......@@ -1102,135 +1102,135 @@
t)
(deftest open.error.2
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(close (open pn :direction :output :if-does-not-exist :create))
(open pn :if-exists :error :direction :output))
file-error)
t)
t t)
(deftest open.error.3
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(close (open pn :direction :output :if-does-not-exist :create))
(open pn :if-exists :error :direction :io))
file-error)
t)
t t)
(deftest open.error.4
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn))
file-error)
t)
t t)
(deftest open.error.5
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :if-does-not-exist :error))
file-error)
t)
t t)
(deftest open.error.6
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :direction :input))
file-error)
t)
t t)
(deftest open.error.7
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :if-does-not-exist :error :direction :input))
file-error)
t)
t t)
(deftest open.error.8
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :direction :output :if-does-not-exist :error))
file-error)
t)
t t)
(deftest open.error.9
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :direction :io :if-does-not-exist :error))
file-error)
t)
t t)
(deftest open.error.10
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :direction :probe :if-does-not-exist :error))
file-error)
t)
t t)
(deftest open.error.11
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :direction :output :if-exists :overwrite))
file-error)
t)
t t)
(deftest open.error.12
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :direction :output :if-exists :append))
file-error)
t)
t t)
(deftest open.error.13
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :direction :io :if-exists :overwrite))
file-error)
t)
t t)
(deftest open.error.14
(signals-error
(signals-error-always
(let ((pn #p"tmp.dat"))
(delete-all-versions pn)
(open pn :direction :io :if-exists :append))
file-error)
t)
t t)
(deftest open.error.15
(signals-error
(signals-error-always
(open (make-pathname :name :wild :type "lsp"))
file-error)
t)
t t)
(deftest open.error.16
(signals-error
(signals-error-always
(open (make-pathname :name "open" :type :wild))
file-error)
t)
t t)
(deftest open.error.17
(signals-error
(signals-error-always
(let ((pn (make-pathname :name "open" :type "lsp" :version :wild)))
(if (wild-pathname-p pn) (open pn)
(error 'file-error)))
file-error)
t)
t t)
(deftest open.error.18
(signals-error
(signals-error-always
(open #p"tmp.dat" :direction :output :if-exists :supersede
:external-form (gensym))
error)
t)
t t)
;;; FIXME -- add tests for :element-type :default
\ No newline at end of file
......@@ -284,36 +284,36 @@
(deftest peek-char.error.2
(signals-error
(signals-error-always
(with-input-from-string
(*standard-input* "")
(peek-char))
end-of-file)
t)
t t)
(deftest peek-char.error.3
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(peek-char nil s))
end-of-file)
t)
t t)
(deftest peek-char.error.4
(signals-error
(signals-error-always
(with-input-from-string
(s " ")
(peek-char t s))
end-of-file)
t)
t t)
(deftest peek-char.error.5
(signals-error
(signals-error-always
(with-input-from-string
(s "abcd")
(peek-char #\z s))
end-of-file)
t)
t t)
;;; There was a consensus on comp.lang.lisp that the requirement
;;; that an end-of-file error be thrown in the following case
......
......@@ -38,9 +38,9 @@
t)
(deftest probe-file.error.3
(signals-error (probe-file (make-pathname :name :wild)) file-error)
t)
(signals-error-always (probe-file (make-pathname :name :wild)) file-error)
t t)
(deftest probe-file.error.4
(signals-error (probe-file "CLTEST:*.FOO") file-error)
t)
(signals-error-always (probe-file "CLTEST:*.FOO") file-error)
t t)
......@@ -115,21 +115,21 @@
t)
(deftest read-byte.error.4
(progn
(let ((s (open "foo.txt"
:direction :output
:if-exists :supersede
:element-type '(unsigned-byte 8))))
(close s))
(signals-error
(signals-error-always
(progn
(let ((s (open "foo.txt"
:direction :input
:element-type '(unsigned-byte 8))))
:direction :output
:if-exists :supersede
:element-type '(unsigned-byte 8))))
(close s))
(let ((s (open "foo.txt"
:direction :input
:element-type '(unsigned-byte 8))))
(unwind-protect
(read-byte s t)
(close s)))
end-of-file))
t)
(close s))))
end-of-file)
t t)
(deftest read-byte.error.5
(loop for x in *mini-universe*
......
......@@ -99,25 +99,25 @@
t)
(deftest read-char-no-hang.error.2
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(read-char-no-hang s))
end-of-file)
t)
t t)
(deftest read-char-no-hang.error.3
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(read-char-no-hang s t))
end-of-file)
t)
t t)
(deftest read-char-no-hang.error.4
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(read-char-no-hang s t t))
end-of-file)
t)
t t)
......@@ -97,25 +97,25 @@
t)
(deftest read-char.error.2
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(read-char s))
end-of-file)
t)
t t)
(deftest read-char.error.3
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(read-char s t))
end-of-file)
t)
t t)
(deftest read-char.error.4
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(read-char s t t))
end-of-file)
t)
t t)
......@@ -79,26 +79,26 @@
t)
(deftest read-line.error.2
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(read-line s))
end-of-file)
t)
t t)
(deftest read-line.error.3
(signals-error
(signals-error-always
(with-input-from-string
(*standard-input* "")
(read-line))
end-of-file)
t)
t t)
(deftest read-line.error.4
(signals-error
(signals-error-always
(with-input-from-string
(s "")
(read-line s t))
end-of-file)
t)
t t)
......@@ -80,25 +80,21 @@
t)
(deftest truename.error.3
(signals-error (truename "nonexistent") file-error)
t)
(signals-error-always (truename "nonexistent") file-error)
t t)
(deftest truename.error.4
(signals-error (truename #p"nonexistent") file-error)
t)
(signals-error-always (truename #p"nonexistent") file-error)
t t)
(deftest truename.error.5
(signals-error (truename (logical-pathname "CLTESTROOT:nonexistent")) file-error)
t)
(signals-error-always (truename (logical-pathname "CLTESTROOT:nonexistent")) file-error)
t t)
(deftest truename.error.6
(signals-error
(signals-error-always
(let ((pn (make-pathname :name :wild
:defaults *default-pathname-defaults*)))
(truename pn)) file-error)
t)
(truename pn))
file-error)
t t)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment