test.lisp

Revision 2878, 6.7 kB (checked in by ksprotte, 9 months ago)
added cl-fad to thirdparty

Line
1	;;; -- Mode: LISP; Syntax: COMMON-LISP; Package: CL-FAD-TEST; Base: 10 --
2	;;; $Header: /usr/local/cvsrep/cl-fad/test.lisp,v 1.11 2008/03/12 00:10:43 edi Exp $
3
4	;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved.
5
6	;;; Redistribution and use in source and binary forms, with or without
7	;;; modification, are permitted provided that the following conditions
8	;;; are met:
9
10	;;; * Redistributions of source code must retain the above copyright
11	;;; notice, this list of conditions and the following disclaimer.
12
13	;;; * Redistributions in binary form must reproduce the above
14	;;; copyright notice, this list of conditions and the following
15	;;; disclaimer in the documentation and/or other materials
16	;;; provided with the distribution.
17
18	;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19	;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20	;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21	;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22	;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23	;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24	;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25	;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26	;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27	;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28	;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
30	(in-package #:cl-fad-test)
31
32	(defparameter tmp-dir
33	#+(or :win32 :mswindows :windows) "c:\\tmp\\"
34	#-(or :win32 :mswindows :windows) "/tmp/")
35
36	(defvar test-counter 0)
37
38	(defmacro assert* (form)
39	`(progn
40	(format t "Trying to assert ~A~%" ',form)
41	(assert ,form)
42	(format t "Test ~A passed.~%" (incf test-counter))))
43
44	(defun test ()
45	(setq test-counter 0)
46	(let ((fad-dir (merge-pathnames (pathname-as-directory "fad-test")
47	tmp-dir)))
48	(delete-directory-and-files fad-dir :if-does-not-exist :ignore)
49	(assert* (directory-pathname-p fad-dir))
50	(assert* (directory-pathname-p (pathname tmp-dir)))
51	(let ((foo-file (merge-pathnames "foo.lisp"
52	fad-dir)))
53	(assert* (not (directory-pathname-p foo-file)))
54	(assert* (not (file-exists-p foo-file)))
55	(assert* (not (file-exists-p fad-dir)))
56	(with-open-file (out (ensure-directories-exist foo-file)
57	:direction :output
58	:if-does-not-exist :create)
59	(write-string "NIL" out))
60	(assert* (file-exists-p foo-file))
61	(assert* (not (directory-exists-p foo-file)))
62	(assert* (file-exists-p fad-dir))
63	(assert* (directory-exists-p fad-dir))
64	(assert* (equal fad-dir
65	(pathname-as-directory fad-dir)))
66	(assert* (equal foo-file
67	(pathname-as-file foo-file)))
68	(assert* (not (equal fad-dir
69	(pathname-as-file fad-dir))))
70	(assert* (not (equal foo-file
71	(pathname-as-directory foo-file))))
72	(dolist (name '("bar" "baz"))
73	(let ((dir (merge-pathnames (pathname-as-directory name)
74	fad-dir)))
75	(dolist (name '("foo.text" "bar.lisp"))
76	(let ((file (merge-pathnames name dir)))
77	(with-open-file (out (ensure-directories-exist file)
78	:direction :output
79	:if-does-not-exist :create)
80	(write-string "NIL" out))))))
81	;; /tmp/fad-test/foo.lisp
82	;; /tmp/fad-test/bar/bar.lisp
83	;; /tmp/fad-test/bar/foo.text
84	;; /tmp/fad-test/baz/bar.lisp
85	;; /tmp/fad-test/baz/foo.text
86	;; files : 5
87	;; dirs : 3
88	(let ((file-counter 0)
89	(file-and-dir-counter 0)
90	(bar-counter 0))
91	(walk-directory fad-dir
92	(lambda (file)
93	(declare (ignore file))
94	(incf file-counter)))
95	;; file-counter => 5
96	(walk-directory fad-dir
97	(lambda (file)
98	(declare (ignore file))
99	(incf file-and-dir-counter))
100	:directories t)
101	;; file-and-dir-counter => 5 + 3
102	(walk-directory fad-dir
103	(lambda (file)
104	(declare (ignore file))
105	(incf bar-counter))
106	:test (lambda (file)
107	(string= (pathname-name file)
108	"bar"))
109	:directories t)
110	;; do not traverse the baz directory
111	(walk-directory fad-dir
112	(lambda (file)
113	(declare (ignore file))
114	(incf file-and-dir-counter))
115	:test (lambda (file)
116	(not (and (directory-pathname-p file)
117	(string= (first (last (pathname-directory file)))
118	"baz"))))
119	:directories :breadth-first)
120	;; file-and-dir-counter => 5 + 3 + 2 dirs + 3 files
121	(assert* (= 5 file-counter))
122	(assert* (= 13 file-and-dir-counter))
123	(assert* (= 2 bar-counter)))
124	(let ((bar-file (merge-pathnames "bar.lisp" fad-dir)))
125	(copy-file foo-file bar-file)
126	(assert* (file-exists-p bar-file))
127	(with-open-file (foo-stream foo-file :element-type '(unsigned-byte 8))
128	(with-open-file (bar-stream bar-file :element-type '(unsigned-byte 8))
129	(assert* (= (file-length foo-stream)
130	(file-length bar-stream)))
131	(loop for foo-byte = (read-byte foo-stream nil nil)
132	for bar-byte = (read-byte bar-stream nil nil)
133	while (and foo-byte bar-byte)
134	do (assert* (eql foo-byte bar-byte))))))
135	(let ((baz-dir (merge-pathnames (pathname-as-directory "baz")
136	fad-dir))
137	(list (mapcar #'namestring (list-directory fad-dir))))
138	(assert* (find (namestring (truename foo-file)) list :test #'string=))
139	(assert* (find (namestring (truename baz-dir)) list :test #'string=))
140	(assert* (not (find (namestring (pathname-as-file baz-dir))
141	list
142	:test #'string=)))))
143	(delete-directory-and-files fad-dir :if-does-not-exist :error)
144	(assert* (not (file-exists-p fad-dir)))
145	(assert* (not (directory-exists-p fad-dir))))
146	(format t "All tests passed.~%"))

Note: See TracBrowser for help on using the browser.

Download in other formats:

Original Format