/[osicat]/src/test-tools.lisp
ViewVC logotype

Contents of /src/test-tools.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Tue Jul 5 16:55:47 2005 UTC (8 years, 9 months ago) by jsquires
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +5 -0 lines
Experimental addition of MAKE-TEMPORARY-FILE, WITH-TEMPORARY-FILE.
Some minor cleanups.
1 ;; Copyright (c) 2003, 2004 Nikodemus Siivola
2 ;;
3 ;; Permission is hereby granted, free of charge, to any person obtaining
4 ;; a copy of this software and associated documentation files (the
5 ;; "Software"), to deal in the Software without restriction, including
6 ;; without limitation the rights to use, copy, modify, merge, publish,
7 ;; distribute, sublicense, and/or sell copies of the Software, and to
8 ;; permit persons to whom the Software is furnished to do so, subject to
9 ;; the following conditions:
10 ;;
11 ;; The above copyright notice and this permission notice shall be included
12 ;; in all copies or substantial portions of the Software.
13 ;;
14 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
17 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
18 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
19 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
20 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21
22 (defpackage :osicat-test
23 (:use :cl :rt :osicat)
24 (:export
25 #:setup
26 #:teardown))
27
28 (in-package :osicat-test)
29
30 ;;; Utilities
31
32 (defvar *test-dir*
33 (merge-pathnames
34 (make-pathname :directory '(:relative "tmp-test-dir"))
35 (make-pathname :directory
36 (pathname-directory #.*compile-file-truename*))))
37
38 (defun ensure-file (file &optional (dir *test-dir*))
39 (let ((file (merge-pathnames file dir)))
40 (or (probe-file file)
41 (with-open-file (f file :direction :output)
42 (probe-file f)))))
43
44 (defun ensure-link (link &key target)
45 (let* ((link (merge-pathnames link *test-dir*))
46 (target (merge-pathnames target *test-dir*))
47 (kind (file-kind link)))
48 (cond ((eq :symbolic-link kind) link)
49 ((null kind) (make-link link :target target))
50 (t (error "File exists and is not a link.")))))
51
52 (defun our-getuid ()
53 #+sbcl (sb-posix:getuid)
54 #+cmu (unix:unix-getuid)
55 #-(or sbcl cmu) 0) ; A sane enough default for testing?
56
57 ;;; Test environment
58
59 (defun teardown ()
60 (assert (search "tmp-test-dir" (namestring *test-dir*)))
61 (asdf:run-shell-command "rm -rf ~A" (namestring *test-dir*)))
62
63 (defun setup ()
64 (teardown)
65 (ensure-directories-exist *test-dir*))
66
67

  ViewVC Help
Powered by ViewVC 1.1.5