Commit 650485b8 authored by uid67352's avatar uid67352

Reinstalled the beginning of the pathname tests. Extend the random test...

Reinstalled the beginning of the pathname tests.  Extend the random test generator to handle various additional forms, including instances of PROGV, DOTIMES, and TAGBODY.
parent 3c36808b
......@@ -5,6 +5,15 @@
(in-package :cl-test)
(compile-and-load "pathnames-aux.lsp")
(load "pathnames.lsp")
(load "pathname.lsp")
(load "make-pathname.lsp")
(load "pathname-host.lsp")
(load "pathname-device.lsp")
(load "pathname-directory.lsp")
(load "pathname-name.lsp")
(load "pathname-type.lsp")
(load "pathname-version.lsp")
......@@ -88,6 +88,26 @@
(make-pathname-test :case :common)
t)
;;; Works on the components of actual pathnames
(deftest make-pathname.rebuild
(loop for p in *pathnames*
for host = (pathname-host p)
for device = (pathname-device p)
for directory = (pathname-directory p)
for name = (pathname-name p)
for type = (pathname-type p)
for version = (pathname-version p)
for p2 = (make-pathname
:host host
:device device
:directory directory
:name name
:type type
:version version)
unless (equal p p2)
collect (list p p2))
nil)
;;; Various constraints on :directory
(deftest make-pathname-error-absolute-up
......
This diff is collapsed.
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Dec 6 14:23:54 2003
;;;; Contains: Tests for PATHNAME-DEVICE
(in-package :cl-test)
(deftest pathname-device.1
(loop for p in *pathnames*
for device = (pathname-device p)
unless (or (stringp device)
(member device '(nil :wild :unspecific)))
collect (list p device))
nil)
(deftest pathname-device.2
(loop for p in *pathnames*
for device = (pathname-device p :case :local)
unless (or (stringp device)
(member device '(nil :wild :unspecific)))
collect (list p device))
nil)
(deftest pathname-device.3
(loop for p in *pathnames*
for device = (pathname-device p :case :common)
unless (or (stringp device)
(member device '(nil :wild :unspecific)))
collect (list p device))
nil)
(deftest pathname-device.4
(loop for p in *pathnames*
for device = (pathname-device p :allow-other-keys nil)
unless (or (stringp device)
(member device '(nil :wild :unspecific)))
collect (list p device))
nil)
(deftest pathname-device.5
(loop for p in *pathnames*
for device = (pathname-device p :foo 'bar :allow-other-keys t)
unless (or (stringp device)
(member device '(nil :wild :unspecific)))
collect (list p device))
nil)
(deftest pathname-device.6
(loop for p in *pathnames*
for device = (pathname-device p :allow-other-keys t :allow-other-keys nil :foo 'bar)
unless (or (stringp device)
(member device '(nil :wild :unspecific)))
collect (list p device))
nil)
(deftest pathname-device.error.1
(classify-error (pathname-device))
program-error)
(deftest pathname-device.error.2
(loop for x in *mini-universe*
unless (or (could-be-pathname-designator x)
(handler-case (progn (pathname-device x) nil)
(type-error () t)
(condition () nil)))
collect x)
nil)
\ No newline at end of file
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Dec 6 14:24:39 2003
;;;; Contains: Tests for PATHNAME-DIRECTORY
(in-package :cl-test)
(deftest pathname-directory.1
(loop for p in *pathnames*
for directory = (pathname-directory p)
unless (or (stringp directory)
(member directory '(nil :wild :unspecific))
(and (consp directory)
(member (car directory) '(:absolute :relative))))
collect (list p directory))
nil)
(deftest pathname-directory.2
(loop for p in *pathnames*
for directory = (pathname-directory p :case :local)
unless (or (stringp directory)
(member directory '(nil :wild :unspecific))
(and (consp directory)
(member (car directory) '(:absolute :relative))))
collect (list p directory))
nil)
(deftest pathname-directory.3
(loop for p in *pathnames*
for directory = (pathname-directory p :case :common)
unless (or (stringp directory)
(member directory '(nil :wild :unspecific))
(and (consp directory)
(member (car directory) '(:absolute :relative))))
collect (list p directory))
nil)
(deftest pathname-directory.4
(loop for p in *pathnames*
for directory = (pathname-directory p :allow-other-keys nil)
unless (or (stringp directory)
(member directory '(nil :wild :unspecific))
(and (consp directory)
(member (car directory) '(:absolute :relative))))
collect (list p directory))
nil)
(deftest pathname-directory.5
(loop for p in *pathnames*
for directory = (pathname-directory p :foo 'bar :allow-other-keys t)
unless (or (stringp directory)
(member directory '(nil :wild :unspecific))
(and (consp directory)
(member (car directory) '(:absolute :relative))))
collect (list p directory))
nil)
(deftest pathname-directory.6
(loop for p in *pathnames*
for directory = (pathname-directory p :allow-other-keys t
:allow-other-keys nil
'foo 'bar)
unless (or (stringp directory)
(member directory '(nil :wild :unspecific))
(and (consp directory)
(member (car directory) '(:absolute :relative))))
collect (list p directory))
nil)
(deftest pathname-directory.error.1
(classify-error (pathname-directory))
program-error)
(deftest pathname-directory.error.2
(loop for x in *mini-universe*
unless (or (could-be-pathname-designator x)
(handler-case (progn (pathname-directory x) nil)
(type-error () t)
(condition () nil)))
collect x)
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Dec 6 14:23:22 2003
;;;; Contains: Tests for PATHNAME-HOST
(in-package :cl-test)
(deftest pathname-host.1
(loop for p in *pathnames*
always (eql (length (multiple-value-list (pathname-host p))) 1))
t)
(deftest pathname-host.2
(loop for p in *pathnames*
always (eql (length (multiple-value-list (pathname-host p :case :local))) 1))
t)
(deftest pathname-host.3
(loop for p in *pathnames*
always (eql (length (multiple-value-list (pathname-host p :case :common))) 1))
t)
(deftest pathname-host.4
(loop for p in *pathnames*
always (eql (length (multiple-value-list (pathname-host p :allow-other-keys nil))) 1))
t)
(deftest pathname-host.5
(loop for p in *pathnames*
always (eql (length (multiple-value-list
(pathname-host p :foo t :allow-other-keys t))) 1))
t)
(deftest pathname-host.6
(loop for p in *pathnames*
always (eql (length (multiple-value-list
(pathname-host p :allow-other-keys t
:allow-other-keys nil
'foo t))) 1))
t)
(deftest pathname-host.error.1
(classify-error (pathname-host))
program-error)
(deftest pathname-host.error.2
(loop for x in *mini-universe*
unless (or (could-be-pathname-designator x)
(handler-case (progn (pathname-host x) nil)
(type-error () t)
(condition () nil)))
collect x)
nil)
(deftest pathname-host.error.3
(classify-error (pathname-host *default-pathname-defaults* '#:bogus t))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Dec 6 14:45:16 2003
;;;; Contains: Tests for PATHNAME-NAME
(in-package :cl-test)
(deftest pathname-name.1
(loop for p in *pathnames*
for name = (pathname-name p)
unless (or (stringp name)
(member name '(nil :wild :unspecific)))
collect (list p name))
nil)
(deftest pathname-name.2
(loop for p in *pathnames*
for name = (pathname-name p :case :local)
unless (or (stringp name)
(member name '(nil :wild :unspecific)))
collect (list p name))
nil)
(deftest pathname-name.3
(loop for p in *pathnames*
for name = (pathname-name p :case :common)
unless (or (stringp name)
(member name '(nil :wild :unspecific)))
collect (list p name))
nil)
(deftest pathname-name.4
(loop for p in *pathnames*
for name = (pathname-name p :allow-other-keys nil)
unless (or (stringp name)
(member name '(nil :wild :unspecific)))
collect (list p name))
nil)
(deftest pathname-name.5
(loop for p in *pathnames*
for name = (pathname-name p :foo 'bar :allow-other-keys t)
unless (or (stringp name)
(member name '(nil :wild :unspecific)))
collect (list p name))
nil)
(deftest pathname-name.6
(loop for p in *pathnames*
for name = (pathname-name p :allow-other-keys t :allow-other-keys nil :foo 'bar)
unless (or (stringp name)
(member name '(nil :wild :unspecific)))
collect (list p name))
nil)
(deftest pathname-name.error.1
(classify-error (pathname-name))
program-error)
(deftest pathname-name.error.2
(loop for x in *mini-universe*
unless (or (could-be-pathname-designator x)
(handler-case (progn (pathname-name x) nil)
(type-error () t)
(condition () nil)))
collect x)
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Dec 6 14:45:16 2003
;;;; Contains: Tests for PATHNAME-TYPE
(in-package :cl-test)
(deftest pathname-type.1
(loop for p in *pathnames*
for type = (pathname-type p)
unless (or (stringp type)
(member type '(nil :wild :unspecific)))
collect (list p type))
nil)
(deftest pathname-type.2
(loop for p in *pathnames*
for type = (pathname-type p :case :local)
unless (or (stringp type)
(member type '(nil :wild :unspecific)))
collect (list p type))
nil)
(deftest pathname-type.3
(loop for p in *pathnames*
for type = (pathname-type p :case :common)
unless (or (stringp type)
(member type '(nil :wild :unspecific)))
collect (list p type))
nil)
(deftest pathname-type.4
(loop for p in *pathnames*
for type = (pathname-type p :allow-other-keys nil)
unless (or (stringp type)
(member type '(nil :wild :unspecific)))
collect (list p type))
nil)
(deftest pathname-type.5
(loop for p in *pathnames*
for type = (pathname-type p :foo 'bar :allow-other-keys t)
unless (or (stringp type)
(member type '(nil :wild :unspecific)))
collect (list p type))
nil)
(deftest pathname-type.6
(loop for p in *pathnames*
for type = (pathname-type p :allow-other-keys t :allow-other-keys nil :foo 'bar)
unless (or (stringp type)
(member type '(nil :wild :unspecific)))
collect (list p type))
nil)
(deftest pathname-type.error.1
(classify-error (pathname-type))
program-error)
(deftest pathname-type.error.2
(loop for x in *mini-universe*
unless (or (could-be-pathname-designator x)
(handler-case (progn (pathname-type x) nil)
(type-error () t)
(condition () nil)))
collect x)
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Dec 6 14:45:16 2003
;;;; Contains: Tests for PATHNAME-VERSION
(in-package :cl-test)
(deftest pathname-version.1
(loop for p in *pathnames*
for version = (pathname-version p)
unless (or (integerp version) (symbolp version))
collect (list p version))
nil)
(deftest pathname-version.error.1
(classify-error (pathname-version))
program-error)
(deftest pathname-version.error.2
(classify-error (pathname-version *default-pathname-defaults* nil))
program-error)
(deftest pathname-version.error.3
(loop for x in *mini-universe*
unless (or (could-be-pathname-designator x)
(handler-case (progn (pathname-version x) nil)
(type-error () t)
(condition () nil)))
collect x)
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Dec 6 10:26:45 2003
;;;; Contains: Tests of PATHNAMEP
(in-package :cl-test)
(deftest pathnamep.1
(loop for x in *universe*
unless (if (pathnamep x) (typep x 'pathname)
(not (typep x 'pathname)))
collect x)
nil)
(deftest pathnamep.2
(loop for x in *universe*
always (eql (length (multiple-value-list (pathnamep x))) 1))
t)
(deftest pathnamep.error.1
(classify-error (pathnamep))
program-error)
(deftest pathnamep.error.2
(classify-error (pathnamep nil nil))
program-error)
(deftest pathnamep.error.3
(classify-error (pathnamep *default-pathname-defaults* nil))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Dec 6 15:05:05 2003
;;;; Contains: Functions associated with pathname tests
(in-package :cl-test)
(defun could-be-pathname-designator (x)
(or (stringp x)
(pathnamep x)
(typep x 'file-stream)
(and (typep x 'synonym-stream)
(could-be-pathname-designator
(symbol-value
(synonym-stream-symbol x))))))
This diff is collapsed.
......@@ -255,9 +255,13 @@
*test* (form entry)
(length (vals entry))
(vals entry))
(format s "Actual value~P: ~
(handler-case
(let ((s (format nil "Actual value~P: ~
~{~S~^~%~15t~}.~%"
(length r) r)))))
(length r) r)))
(format t "~A" s))
(error () (format t "Actual value~P: #<error during printing>~%"))
)))))
(when (not (pend entry)) *test*))
(defun expanded-eval (form)
......
......@@ -319,13 +319,17 @@
(defparameter *pathnames*
(append
(ignore-errors (list (make-pathname :name "foo")))
(ignore-errors (list (make-pathname :name "FOO" :case :common)))
(ignore-errors (list (make-pathname :name "bar")))
(ignore-errors (list (make-pathname :name "foo" :type "txt")))
(ignore-errors (list (make-pathname :name "bar" :type "txt")))
(ignore-errors (list (make-pathname :name "XYZ" :type "TXT" :case :common)))
(ignore-errors (list (make-pathname :name nil)))
(ignore-errors (list (make-pathname :name :wild)))
(ignore-errors (list (make-pathname :name nil :type "txt")))
(ignore-errors (list (make-pathname :name :wild :type "txt")))
(ignore-errors (list (make-pathname :name :wild :type "TXT" :case :common)))
(ignore-errors (list (make-pathname :name :wild :type "abc" :case :common)))
(ignore-errors (list (make-pathname :directory :wild)))
(ignore-errors (list (make-pathname :type :wild)))
(ignore-errors (list (make-pathname :version :wild)))
......
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