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