Changeset 10101


Ignore:
Timestamp:
10/14/05 16:59:22 (16 years ago)
Author:
piso
Message:

MAKE-TEMPORARY-DIRECTORY

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/tests/file-system-tests.lisp

    r10095 r10101  
    5555
    5656(export '(pathnames-equal-p run-shell-command copy-file make-symbolic-link
    57           touch delete-directory-and-files))
     57          touch make-temporary-directory delete-directory-and-files))
    5858
    5959(defparameter *this-file*
     
    170170    (zerop (run-shell-command command))))
    171171
    172 ;; This approach is race-prone, but it should be adequate for our limited
    173 ;; purposes here.
    174 (defun make-temporary-filename (directory)
    175   (dotimes (i 10)
    176     (let ((pathname (merge-pathnames (make-pathname :name (symbol-name (gensym))
    177                                                     :type nil)
    178                                      directory)))
    179       (unless (probe-file pathname)
    180         (return-from make-temporary-filename pathname))))
    181    (error "Unable to create a temporary filename in ~S~%" directory))
    182 
    183 (defun touch (filespec)
    184   (with-open-file (stream filespec :direction :output :if-exists :error)))
    185 
    186172(defun probe-directory (pathname)
    187173  #+abcl (ext:probe-directory pathname)
     
    216202  #+lispworks (lw:delete-directory pathname)
    217203  )
     204
     205;; This approach is race-prone, but it should be adequate for our limited
     206;; purposes here.
     207(defun make-temporary-filename (directory)
     208  (unless (probe-directory directory)
     209    (error "The directory ~S does not exist." directory))
     210  (dotimes (i 10)
     211    (let ((pathname (merge-pathnames (make-pathname :name (symbol-name (gensym))
     212                                                    :type nil)
     213                                     directory)))
     214      (unless (probe-file pathname)
     215        (return-from make-temporary-filename pathname))))
     216  (error "Unable to create a temporary filename in ~S" directory))
     217
     218(defun touch (filespec)
     219  (with-open-file (stream filespec :direction :output :if-exists :error)))
     220
     221(defun make-temporary-directory (parent-directory)
     222  (let* ((tmp (make-temporary-filename parent-directory))
     223         (directory-namestring (concatenate 'string (namestring tmp) "/"))
     224         (directory-pathname (pathname directory-namestring)))
     225    (make-directory directory-pathname)
     226    directory-pathname))
    218227
    219228(defun delete-directory-and-files (pathspec &key (quiet t) (dry-run nil))
     
    337346;; Verify that DIRECTORY returns nil if the directory is empty.
    338347(deftest directory.2
    339   (let* ((tmp (make-temporary-filename *this-directory*))
    340          (directory-namestring (concatenate 'string (namestring tmp) "/"))
    341          (directory-pathname (pathname directory-namestring)))
     348  (let ((directory-pathname (make-temporary-directory *this-directory*)))
    342349    (unwind-protect
    343         (progn
    344           (make-directory directory-pathname)
    345           (directory (make-pathname :name :wild :defaults directory-pathname)))
     350        (directory (make-pathname :name :wild :defaults directory-pathname))
    346351      (delete-directory-and-files directory-pathname)))
    347352  nil)
     
    349354;; A directory with a one file named "foo".
    350355(deftest directory.3
    351   (let* ((tmp (make-temporary-filename *this-directory*))
    352          (directory-namestring (concatenate 'string (namestring tmp) "/"))
    353          (directory-pathname (pathname directory-namestring)))
     356  (let ((directory-pathname (make-temporary-directory *this-directory*)))
    354357    (unwind-protect
    355         (progn
    356           (make-directory directory-pathname)
    357           (let ((file-pathname (make-pathname :name "foo" :defaults directory-pathname)))
    358             (touch file-pathname)
    359             (let ((directory (directory (make-pathname :name :wild
    360                                                        :defaults directory-pathname))))
    361               (and (listp directory)
    362                    (= (length directory) 1)
    363                    (pathnames-equal-p (car directory) file-pathname)))))
     358        (let ((file-pathname (make-pathname :name "foo" :defaults directory-pathname)))
     359          (touch file-pathname)
     360          (let ((directory (directory (make-pathname :name :wild
     361                                                     :defaults directory-pathname))))
     362            (and (listp directory)
     363                 (= (length directory) 1)
     364                 (pathnames-equal-p (car directory) file-pathname))))
    364365      (delete-directory-and-files directory-pathname)))
    365366  t)
     
    367368;; Same as DIRECTORY.3, but use :type :wild for the wildcard.
    368369(deftest directory.4
    369   (let* ((tmp (make-temporary-filename *this-directory*))
    370          (directory-namestring (concatenate 'string (namestring tmp) "/"))
    371          (directory-pathname (pathname directory-namestring)))
     370  (let ((directory-pathname (make-temporary-directory *this-directory*)))
    372371    (unwind-protect
    373         (progn
    374           (make-directory directory-pathname)
    375           (let ((file-pathname (make-pathname :name "foo" :defaults directory-pathname)))
    376             (touch file-pathname)
    377             (let ((directory (directory (make-pathname :name :wild
    378                                                        :type :wild
    379                                                        :defaults directory-pathname))))
    380               (and (listp directory)
    381                    (= (length directory) 1)
    382                    (pathnames-equal-p (car directory) file-pathname)))))
     372        (let ((file-pathname (make-pathname :name "foo" :defaults directory-pathname)))
     373          (touch file-pathname)
     374          (let ((directory (directory (make-pathname :name :wild
     375                                                     :type :wild
     376                                                     :defaults directory-pathname))))
     377            (and (listp directory)
     378                 (= (length directory) 1)
     379                 (pathnames-equal-p (car directory) file-pathname))))
    383380      (delete-directory-and-files directory-pathname)))
    384381  t)
Note: See TracChangeset for help on using the changeset viewer.