Commit 4d5307a6 authored by pfdietz's avatar pfdietz

Add stub file for tests of logical-pathname-translations. Begin adding tests...

Add stub file for tests of logical-pathname-translations.  Begin adding tests of merge-pathnames.  Add another make-pathname test (that *default-pathname-defaults* is really used for defaulting.)
parent 06c2a0f5
......@@ -20,4 +20,7 @@
(load "load-logical-pathname-translations.lsp")
(load "logical-pathname.lsp")
(load "logical-pathname-translations.lsp")
(load "translate-logical-pathname.lsp")
(load "merge-pathnames.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Wed Dec 31 09:46:08 2003
;;;; Contains: Tests of LOGICAL-PATHNAME-TRANSLATIONS
(in-package :cl-test)
......@@ -88,6 +88,12 @@
(make-pathname-test :case :common)
t)
(deftest make-pathname.14
(let ((*default-pathname-defaults*
(make-pathname :name "foo" :type "lsp" :version :newest)))
(make-pathname-test))
t)
;;; Works on the components of actual pathnames
(deftest make-pathname.rebuild
(loop for p in *pathnames*
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Wed Dec 31 11:25:55 2003
;;;; Contains: Tests of MERGE-PATHNAMES
(in-package :cl-test)
(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
(list p1 p2))))
t t)
(deftest merge-pathnames.2
(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))
(if (pathname-version p1)
(equalt (pathname-version p1) (pathname-version p2))
(equalt (pathname-version p2) :newest))))
t t t t t 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))
(if (pathname-version p1)
(equalt (pathname-version p1) (pathname-version p3))
(equalt (pathname-version p3) :newest))))
t t t t t 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))
(if (pathname-version p1)
(equalt (pathname-version p1) (pathname-version p3))
(equalt (pathname-version p3) :newest))))
t t t t t t 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)
(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))
(pathname-version p2)
(pathname-version p3)))
t t t t t t :newest :newest)
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