From 888e046be74981a37c67e06d49897025b83e76c7 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 15 Aug 2004 13:36:35 +0000 Subject: [PATCH] Add tests for pathname-match-p --- ansi-tests/load-pathnames.lsp | 2 + ansi-tests/pathname-match-p.lsp | 102 ++++++++++++++++++++++++++++++++ 2 files changed, 104 insertions(+) create mode 100644 ansi-tests/pathname-match-p.lsp diff --git a/ansi-tests/load-pathnames.lsp b/ansi-tests/load-pathnames.lsp index a0491a00..1dce6f52 100644 --- a/ansi-tests/load-pathnames.lsp +++ b/ansi-tests/load-pathnames.lsp @@ -25,3 +25,5 @@ (load "wild-pathname-p.lsp") (load "merge-pathnames.lsp") +(load "pathname-match-p.lsp") + diff --git a/ansi-tests/pathname-match-p.lsp b/ansi-tests/pathname-match-p.lsp new file mode 100644 index 00000000..01b1dd6f --- /dev/null +++ b/ansi-tests/pathname-match-p.lsp @@ -0,0 +1,102 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Aug 15 07:46:22 2004 +;;;; Contains: Tests for PATHNAME-MATCH-P + +(in-package :cl-test) + +(compile-and-load "pathnames-aux.lsp") + +;;; Much of the behavior cannot be tested portably. + +(deftest pathname-match-p.1 + (let ((pn1 (make-pathname :name :wild)) + (pn2 (make-pathname :name "foo"))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.2 + (let ((pn1 (make-pathname :type :wild)) + (pn2 (make-pathname :type "txt"))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.3 + (let ((pn1 (make-pathname :directory '(:absolute :wild))) + (pn2 (make-pathname :directory '(:absolute)))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.4 + (let ((pn1 (make-pathname :directory '(:relative :wild))) + (pn2 (make-pathname :directory '(:relative)))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.5 + (let ((pn1 (make-pathname :directory '(:relative :wild))) + (pn2 (make-pathname :directory nil))) + (pathname-match-p pn1 pn2)) + nil) + +(deftest pathname-match-p.6 + (let ((pn1 (make-pathname :version :wild)) + (pn2 (make-pathname))) + (and (wild-pathname-p pn1) + (not (wild-pathname-p pn2)) + (pathname-match-p pn1 pn2))) + nil) + +;;; Here are error tests + +(deftest pathname-match-p.error.1 + (signals-error (pathname-match-p) program-error) + t) + +(deftest pathname-match-p.error.2 + (signals-error (pathname-match-p #p"") program-error) + t) + +(deftest pathname-match-p.error.3 + (signals-error (pathname-match-p #p"" #p"" nil) program-error) + t) + +(deftest pathname-match-p.error.4 + (loop for x in *mini-universe* + unless (or (could-be-pathname-designator x) + (eval `(signals-error (pathname-match-p ',x #p"") + type-error))) + collect x) + nil) + +(deftest pathname-match-p.error.5 + (loop for x in *mini-universe* + unless (or (could-be-pathname-designator x) + (eval `(signals-error (pathname-match-p ',x #p"") + type-error + :safety 0))) + collect x) + nil) + +(deftest pathname-match-p.error.6 + (loop for x in *mini-universe* + unless (or (could-be-pathname-designator x) + (eval `(signals-error (pathname-match-p #p"" ',x) + type-error))) + collect x) + nil) + +(deftest pathname-match-p.error.7 + (loop for x in *mini-universe* + unless (or (could-be-pathname-designator x) + (eval `(signals-error (pathname-match-p #p"" ',x) + type-error + :safety 0))) + collect x) + nil) + + + + + + -- GitLab