From 30eebe06dafd10d53a2661b98612b67102fa9f38 Mon Sep 17 00:00:00 2001 From: pfdietz Date: Wed, 31 Dec 2003 01:33:17 +0000 Subject: [PATCH] Added more pathname tests, particular tests involving logical pathnames. --- ansi-tests/load-pathnames.lsp | 2 ++ ansi-tests/logical-pathname.lsp | 13 +++++++++++++ ansi-tests/pathname-device.lsp | 6 ++++++ ansi-tests/pathname-directory.lsp | 7 +++++++ ansi-tests/pathname-host.lsp | 7 +++++++ ansi-tests/pathname-name.lsp | 7 +++++++ ansi-tests/pathname-type.lsp | 7 +++++++ ansi-tests/pathname-version.lsp | 7 +++++++ ansi-tests/pathname.lsp | 21 ++++++++++++++++++++- ansi-tests/pathnamep.lsp | 6 ++++++ ansi-tests/universe.lsp | 5 ++++- 11 files changed, 86 insertions(+), 2 deletions(-) create mode 100644 ansi-tests/logical-pathname.lsp diff --git a/ansi-tests/load-pathnames.lsp b/ansi-tests/load-pathnames.lsp index 262667a..2a53aaa 100644 --- a/ansi-tests/load-pathnames.lsp +++ b/ansi-tests/load-pathnames.lsp @@ -9,6 +9,7 @@ (load "pathnames.lsp") (load "pathname.lsp") +(load "pathnamep.lsp") (load "make-pathname.lsp") (load "pathname-host.lsp") (load "pathname-device.lsp") @@ -17,4 +18,5 @@ (load "pathname-type.lsp") (load "pathname-version.lsp") +(load "logical-pathname.lsp") (load "translate-logical-pathname.lsp") diff --git a/ansi-tests/logical-pathname.lsp b/ansi-tests/logical-pathname.lsp new file mode 100644 index 0000000..8197e89 --- /dev/null +++ b/ansi-tests/logical-pathname.lsp @@ -0,0 +1,13 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Dec 30 19:05:01 2003 +;;;; Contains: Tests of LOGICAL-PATHNAME + +(in-package :cl-test) + +(deftest logical-pathname.1 + (loop for x in *logical-pathnames* + always (eql x (logical-pathname x))) + t) + + diff --git a/ansi-tests/pathname-device.lsp b/ansi-tests/pathname-device.lsp index b576083..7038839 100644 --- a/ansi-tests/pathname-device.lsp +++ b/ansi-tests/pathname-device.lsp @@ -53,6 +53,12 @@ collect (list p device)) nil) +;;; section 19.3.2.1 +(deftest pathname-device.7 + (loop for p in *logical-pathnames* + always (eq (pathname-device p) :unspecific)) + t) + (deftest pathname-device.error.1 (classify-error (pathname-device)) program-error) diff --git a/ansi-tests/pathname-directory.lsp b/ansi-tests/pathname-directory.lsp index 585782c..d5145b2 100644 --- a/ansi-tests/pathname-directory.lsp +++ b/ansi-tests/pathname-directory.lsp @@ -67,6 +67,13 @@ collect (list p directory)) nil) +;;; section 19.3.2.1 +(deftest pathname-directory.7 + (loop for p in *logical-pathnames* + when (eq (pathname-directory p) :unspecific) + collect p) + nil) + (deftest pathname-directory.error.1 (classify-error (pathname-directory)) program-error) diff --git a/ansi-tests/pathname-host.lsp b/ansi-tests/pathname-host.lsp index f4cca52..e238057 100644 --- a/ansi-tests/pathname-host.lsp +++ b/ansi-tests/pathname-host.lsp @@ -39,6 +39,13 @@ 'foo t))) 1)) t) +;;; section 19.3.2.1 +(deftest pathname-host.7 + (loop for p in *logical-pathnames* + when (eq (pathname-host p) :unspecific) + collect p) + nil) + (deftest pathname-host.error.1 (classify-error (pathname-host)) program-error) diff --git a/ansi-tests/pathname-name.lsp b/ansi-tests/pathname-name.lsp index c674cd6..24363e2 100644 --- a/ansi-tests/pathname-name.lsp +++ b/ansi-tests/pathname-name.lsp @@ -53,6 +53,13 @@ collect (list p name)) nil) +;;; section 19.3.2.1 +(deftest pathname-name.7 + (loop for p in *logical-pathnames* + when (eq (pathname-name p) :unspecific) + collect p) + nil) + (deftest pathname-name.error.1 (classify-error (pathname-name)) program-error) diff --git a/ansi-tests/pathname-type.lsp b/ansi-tests/pathname-type.lsp index 3cf8903..1d02292 100644 --- a/ansi-tests/pathname-type.lsp +++ b/ansi-tests/pathname-type.lsp @@ -53,6 +53,13 @@ collect (list p type)) nil) +;;; section 19.3.2.1 +(deftest pathname-type.7 + (loop for p in *logical-pathnames* + when (eq (pathname-type p) :unspecific) + collect p) + nil) + (deftest pathname-type.error.1 (classify-error (pathname-type)) program-error) diff --git a/ansi-tests/pathname-version.lsp b/ansi-tests/pathname-version.lsp index 610079a..bac0bee 100644 --- a/ansi-tests/pathname-version.lsp +++ b/ansi-tests/pathname-version.lsp @@ -12,6 +12,13 @@ collect (list p version)) nil) +;;; section 19.3.2.1 +(deftest pathname-version.2 + (loop for p in *logical-pathnames* + when (eq (pathname-version p) :unspecific) + collect p) + nil) + (deftest pathname-version.error.1 (classify-error (pathname-version)) program-error) diff --git a/ansi-tests/pathname.lsp b/ansi-tests/pathname.lsp index de5afd6..aa9db1b 100644 --- a/ansi-tests/pathname.lsp +++ b/ansi-tests/pathname.lsp @@ -10,7 +10,26 @@ always (eq x (pathname x))) t) -;;; More here +(deftest pathname.2 + (equalt #p"ansi-aux.lsp" (pathname "ansi-aux.lsp")) + t) + +(deftest pathname.3 + (let ((s (open "ansi-aux.lsp" :direction :input))) + (prog1 (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp")) + (close s))) + t) + +(deftest pathname.4 + (let ((s (open "ansi-aux.lsp" :direction :input))) + (close s) + (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp"))) + t) + +(deftest pathname.5 + (loop for x in *logical-pathnames* + always (eq x (pathname x))) + t) ;;; Error tests diff --git a/ansi-tests/pathnamep.lsp b/ansi-tests/pathnamep.lsp index 37ff310..a0d315f 100644 --- a/ansi-tests/pathnamep.lsp +++ b/ansi-tests/pathnamep.lsp @@ -17,6 +17,12 @@ always (eql (length (multiple-value-list (pathnamep x))) 1)) t) +(deftest pathnamep.3 + (loop for x in *universe* + always (or (not (typep x 'logical-pathname)) + (pathnamep x))) + t) + (deftest pathnamep.error.1 (classify-error (pathnamep)) program-error) diff --git a/ansi-tests/universe.lsp b/ansi-tests/universe.lsp index 9bb5ec0..e35e61b 100644 --- a/ansi-tests/universe.lsp +++ b/ansi-tests/universe.lsp @@ -338,7 +338,10 @@ (eval-when (load eval compile) (setf (logical-pathname-translations "CLTESTROOT") - `(("**;*.*.*" ,(make-pathname :directory '(:absolute)))))) + `(("**;*.*.*" ,(make-pathname :directory '(:absolute))))) + (setf (logical-pathname-translations "CLTEST") + `(("**;*.*.*" ,(make-pathname)))) + ) (defparameter *logical-pathnames* (append -- GitLab