Commit 1235074c authored by pfdietz's avatar pfdietz

Added more merge-pathnames tests. Added tests for wild-pathname-p.

parent 4d5307a6
......@@ -23,4 +23,5 @@
(load "logical-pathname-translations.lsp")
(load "translate-logical-pathname.lsp")
(load "wild-pathname-p.lsp")
(load "merge-pathnames.lsp")
......@@ -5,12 +5,24 @@
(in-package :cl-test)
#|
(defun merge-pathnames-test (&rest args)
(assert (<= 1 (length args) 3))
(let* ((p1 (car args))
(p2 (if (cdr args) (cadr args) *default-pathname-defaults*))
(default-version (if (cddr args) (caddr args) :newest))
(results (multiple-value-list (apply #'merge-pathnames args))))
(assert (= (length results) 1))
(let ((p3 (first results)))
|#
(deftest merge-pathnames.1
(let* ((p1 (make-pathname :name "foo"))
(p2 (merge-pathnames p1 p1 nil)))
(values
(equalt (pathname-name p1) "foo")
(if (equalt p1 p2) t
(equalpt (pathname-name p1) "foo")
(if (equalpt p1 p2) t
(list p1 p2))))
t t)
......@@ -18,80 +30,95 @@
(let* ((p1 (make-pathname :name "foo"))
(p2 (merge-pathnames p1 p1)))
(values
(equalt (pathname-host p1) (pathname-host p2))
(equalt (pathname-device p1) (pathname-device p2))
(equalt (pathname-directory p1) (pathname-directory p2))
(equalt (pathname-name p1) (pathname-name p2))
(equalt (pathname-name p1) "foo")
(equalt (pathname-type p1) (pathname-type p2))
(equalpt (pathname-host p1) (pathname-host p2))
(equalpt (pathname-device p1) (pathname-device p2))
(equalpt (pathname-directory p1) (pathname-directory p2))
(pathname-name p1)
(pathname-name p2)
(equalpt (pathname-type p1) (pathname-type p2))
(if (pathname-version p1)
(equalt (pathname-version p1) (pathname-version p2))
(equalt (pathname-version p2) :newest))))
t t t t t t t)
(equalpt (pathname-version p1) (pathname-version p2))
(equalpt (pathname-version p2) :newest))))
t t t "foo" "foo" t t)
(deftest merge-pathnames.3
(let* ((p1 (make-pathname :name "foo"))
(p2 (make-pathname :name "bar"))
(p3 (merge-pathnames p1 p2)))
(values
(equalt (pathname-host p1) (pathname-host p3))
(equalt (pathname-device p1) (pathname-device p3))
(equalt (pathname-directory p1) (pathname-directory p3))
(equalt (pathname-name p1) (pathname-name p3))
(equalt (pathname-name p1) "foo")
(equalt (pathname-type p1) (pathname-type p3))
(equalpt (pathname-host p1) (pathname-host p3))
(equalpt (pathname-device p1) (pathname-device p3))
(equalpt (pathname-directory p1) (pathname-directory p3))
(pathname-name p1)
(pathname-name p3)
(equalpt (pathname-type p1) (pathname-type p3))
(if (pathname-version p1)
(equalt (pathname-version p1) (pathname-version p3))
(equalt (pathname-version p3) :newest))))
t t t t t t t)
(equalpt (pathname-version p1) (pathname-version p3))
(equalpt (pathname-version p3) :newest))))
t t t "foo" "foo" t t)
(deftest merge-pathnames.4
(let* ((p1 (make-pathname :name "foo"))
(p2 (make-pathname :type "lsp"))
(p3 (merge-pathnames p1 p2)))
(values
(equalt (pathname-host p1) (pathname-host p3))
(equalt (pathname-device p1) (pathname-device p3))
(equalt (pathname-directory p1) (pathname-directory p3))
(equalt (pathname-name p1) (pathname-name p3))
(equalt (pathname-name p1) "foo")
(equalt (pathname-type p3) "lsp")
(equalt (pathname-type p2) (pathname-type p3))
(equalpt (pathname-host p1) (pathname-host p3))
(equalpt (pathname-device p1) (pathname-device p3))
(equalpt (pathname-directory p1) (pathname-directory p3))
(pathname-name p1)
(pathname-type p2)
(pathname-type p3)
(equalpt (pathname-type p2) (pathname-type p3))
(if (pathname-version p1)
(equalt (pathname-version p1) (pathname-version p3))
(equalt (pathname-version p3) :newest))))
t t t t t t t t)
(equalpt (pathname-version p1) (pathname-version p3))
(equalpt (pathname-version p3) :newest))))
t t t "foo" "lsp" "lsp" t t)
(deftest merge-pathnames.5
(let* ((p1 (make-pathname :name "foo"))
(p2 (make-pathname :type "lsp" :version :newest))
(p3 (merge-pathnames p1 p2 nil)))
(values
(equalt (pathname-host p1) (pathname-host p3))
(equalt (pathname-device p1) (pathname-device p3))
(equalt (pathname-directory p1) (pathname-directory p3))
(equalt (pathname-name p1) (pathname-name p3))
(equalt (pathname-name p1) "foo")
(equalt (pathname-type p3) "lsp")
(equalt (pathname-type p2) (pathname-type p3))
(equalt (pathname-version p1) (pathname-version p3))))
t t t t t t t t)
(equalpt (pathname-host p1) (pathname-host p3))
(equalpt (pathname-device p1) (pathname-device p3))
(equalpt (pathname-directory p1) (pathname-directory p3))
(pathname-name p1)
(pathname-name p3)
(pathname-type p2)
(pathname-type p3)
(equalpt (pathname-version p1) (pathname-version p3))))
t t t "foo" "foo" "lsp" "lsp" t)
(deftest merge-pathnames.6
(let* ((p1 (make-pathname))
(p2 (make-pathname :name "foo" :version :newest))
(p3 (merge-pathnames p1 p2 nil)))
(values
(equalt (pathname-host p1) (pathname-host p3))
(equalt (pathname-device p1) (pathname-device p3))
(equalt (pathname-directory p1) (pathname-directory p3))
(equalt (pathname-name p2) (pathname-name p3))
(equalt (pathname-name p3) "foo")
(equalt (pathname-type p2) (pathname-type p3))
(equalpt (pathname-host p1) (pathname-host p3))
(equalpt (pathname-device p1) (pathname-device p3))
(equalpt (pathname-directory p1) (pathname-directory p3))
(pathname-name p2)
(pathname-name p3)
(equalpt (pathname-type p2) (pathname-type p3))
(pathname-version p2)
(pathname-version p3)))
t t t t t t :newest :newest)
t t t "foo" "foo" t :newest :newest)
(deftest merge-pathnames.7
(let* ((p1 (make-pathname))
(p2 *default-pathname-defaults*)
(p3 (merge-pathnames p1)))
(values
(equalpt (pathname-host p1) (pathname-host p3))
(equalpt (pathname-host p2) (pathname-host p3))
(equalpt (pathname-device p2) (pathname-device p3))
(equalpt (pathname-directory p2) (pathname-directory p3))
(equalpt (pathname-name p2) (pathname-name p3))
(equalpt (pathname-type p2) (pathname-type p3))
(cond
((pathname-version p1) (equalpt (pathname-version p1)
(pathname-version p3)))
((pathname-version p2) (equalpt (pathname-version p2)
(pathname-version p3)))
(t (equalpt (pathname-version p3) :newest)))))
t t t t t t t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Wed Dec 31 16:54:55 2003
;;;; Contains: Tests of WILD-PATHNAME-P
(in-package :cl-test)
(deftest wild-pathname-p.1
(wild-pathname-p (make-pathname))
nil)
(deftest wild-pathname-p.2
(loop for key in '(:host :device :directory :name :type :version nil)
when (wild-pathname-p (make-pathname) key)
collect key)
nil)
(deftest wild-pathname-p.3
(let ((p (make-pathname :directory :wild)))
(notnot-mv (wild-pathname-p p)))
t)
(deftest wild-pathname-p.4
(let ((p (make-pathname :directory :wild)))
(notnot-mv (wild-pathname-p p nil)))
t)
(deftest wild-pathname-p.5
(let ((p (make-pathname :directory :wild)))
(notnot-mv (wild-pathname-p p :directory)))
t)
(deftest wild-pathname-p.6
(let ((p (make-pathname :directory :wild)))
(loop for key in '(:host :device :name :type :version)
when (wild-pathname-p p key)
collect key))
nil)
(deftest wild-pathname-p.7
(let ((p (make-pathname :directory '(:absolute :wild))))
(notnot-mv (wild-pathname-p p)))
t)
(deftest wild-pathname-p.8
(let ((p (make-pathname :directory '(:absolute :wild))))
(notnot-mv (wild-pathname-p p nil)))
t)
(deftest wild-pathname-p.9
(let ((p (make-pathname :directory '(:absolute :wild))))
(notnot-mv (wild-pathname-p p :directory)))
t)
(deftest wild-pathname-p.10
(let ((p (make-pathname :directory '(:absolute :wild))))
(loop for key in '(:host :device :name :type :version)
when (wild-pathname-p p key)
collect key))
nil)
(deftest wild-pathname-p.11
(let ((p (make-pathname :directory '(:relative :wild))))
(notnot-mv (wild-pathname-p p)))
t)
(deftest wild-pathname-p.12
(let ((p (make-pathname :directory '(:relative :wild))))
(notnot-mv (wild-pathname-p p nil)))
t)
(deftest wild-pathname-p.13
(let ((p (make-pathname :directory '(:relative :wild))))
(notnot-mv (wild-pathname-p p :directory)))
t)
(deftest wild-pathname-p.14
(let ((p (make-pathname :directory '(:relative :wild))))
(loop for key in '(:host :device :name :type :version)
when (wild-pathname-p p key)
collect key))
nil)
;;;
(deftest wild-pathname-p.15
(let ((p (make-pathname :name :wild)))
(notnot-mv (wild-pathname-p p)))
t)
(deftest wild-pathname-p.16
(let ((p (make-pathname :name :wild)))
(notnot-mv (wild-pathname-p p nil)))
t)
(deftest wild-pathname-p.17
(let ((p (make-pathname :name :wild)))
(notnot-mv (wild-pathname-p p :name)))
t)
(deftest wild-pathname-p.18
(let ((p (make-pathname :name :wild)))
(loop for key in '(:host :device :directory :type :version)
when (wild-pathname-p p key)
collect key))
nil)
;;;
(deftest wild-pathname-p.19
(let ((p (make-pathname :type :wild)))
(notnot-mv (wild-pathname-p p)))
t)
(deftest wild-pathname-p.20
(let ((p (make-pathname :type :wild)))
(notnot-mv (wild-pathname-p p nil)))
t)
(deftest wild-pathname-p.21
(let ((p (make-pathname :type :wild)))
(notnot-mv (wild-pathname-p p :type)))
t)
(deftest wild-pathname-p.22
(let ((p (make-pathname :type :wild)))
(loop for key in '(:host :device :directory :name :version)
when (wild-pathname-p p key)
collect key))
nil)
;;;
(deftest wild-pathname-p.23
(let ((p (make-pathname :version :wild)))
(notnot-mv (wild-pathname-p p)))
t)
(deftest wild-pathname-p.24
(let ((p (make-pathname :version :wild)))
(notnot-mv (wild-pathname-p p nil)))
t)
(deftest wild-pathname-p.25
(let ((p (make-pathname :version :wild)))
(notnot-mv (wild-pathname-p p :version)))
t)
(deftest wild-pathname-p.26
(let ((p (make-pathname :version :wild)))
(loop for key in '(:host :device :directory :name :type)
when (wild-pathname-p p key)
collect key))
nil)
;;;
(deftest wild-pathname-p.27
(loop for p in *pathnames*
unless (if (wild-pathname-p p) (wild-pathname-p p nil)
(not (wild-pathname-p p nil)))
collect p)
nil)
(deftest wild-pathname-p.28
(loop for p in *pathnames*
when (and (loop for key in '(:host :device :directory
:name :type :version)
thereis (wild-pathname-p p key))
(not (wild-pathname-p p)))
collect p)
nil)
;;;
(deftest wild-pathname-p.error.1
(classify-error (wild-pathname-p))
program-error)
(deftest wild-pathname-p.error.2
(classify-error (wild-pathname-p *default-pathname-defaults* nil nil))
program-error)
(deftest wild-pathname-p.error.3
(loop for x in *mini-universe*
when (and (not (could-be-pathname-designator x))
(not (eq (eval `(classify-error
(wild-pathname-p ',x)))
'type-error)))
collect x)
nil)
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