Changeset 10078


Ignore:
Timestamp:
10/05/05 16:35:37 (16 years ago)
Author:
piso
Message:

DIRECTORY.2

File:
1 edited

Legend:

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

    r10070 r10078  
    4747(in-package #:test)
    4848
    49 (export '(pathnames-equal-p run-shell-command copy-file make-symbolic-link))
     49(export '(pathnames-equal-p run-shell-command copy-file make-symbolic-link
     50          touch delete-directory-and-files))
    5051
    5152(defparameter *this-file*
     
    173174   (error "Unable to create a temporary filename in ~S~%" directory))
    174175
     176(defun touch (filespec)
     177  (with-open-file (stream filespec :direction :output :if-exists :error)))
     178
    175179(defun probe-directory (pathname)
    176180  #+abcl (ext:probe-directory pathname)
     
    181185  )
    182186
     187(defun file-directory-p (pathname)
     188  #+abcl (ext:file-directory-p pathname)
     189  #+allegro (excl:file-directory-p pathname)
     190  #-(or abcl allegro)
     191  (let* ((namestring (namestring pathname))
     192         (len (length namestring))
     193         (last-char (and (> len 0) (char namestring (1- len)))))
     194    (eql last-char #+windows #\\ #-windows #\/)))
     195
    183196(defun make-directory (pathname)
    184   #+allegro (excl:make-directory pathname)
     197  #+allegro
     198  (excl:make-directory pathname)
    185199  #-allegro
    186   (let ((namestring (directory-namestring pathname))
    187         )
    188     ))
     200  (and (ensure-directories-exist pathname) t))
    189201
    190202(defun delete-directory (pathname)
     
    195207  #+sbcl (zerop (sb-posix:rmdir (namestring pathname)))
    196208  )
     209
     210(defun delete-directory-and-files (pathspec &key (quiet t))
     211  #+(or clisp lispworks)
     212  (error "DELETE-DIRECTORY-AND-FILES doesn't work on CLISP or LispWorks yet!")
     213  (let* ((namestring (namestring pathspec))
     214         (len (length namestring))
     215         (last-char (and (> len 0) (char namestring (1- len)))))
     216    (unless (eql last-char #+windows #\\ #-windows #\/)
     217      (setf namestring (concatenate 'string namestring #+windows "\\" #-windows "/")))
     218    (let ((pathname (pathname namestring)))
     219      (unless (probe-directory pathname)
     220        (error "Directory does not exist: ~S" pathname))
     221      (unless quiet
     222        (format t "processing directory ~S~%" pathname))
     223      (let ((list (directory (make-pathname :name :wild
     224                                            :type :wild
     225                                            :defaults pathname))))
     226        (dolist (x list)
     227          (cond ((file-directory-p x)
     228                 (delete-directory-and-files x :quiet quiet))
     229                (t
     230                 (delete-file x)
     231                 (unless quiet
     232                   (format t "deleting file ~S~%" x))
     233                 )))
     234        (unless quiet
     235          (format t "deleting directory ~S~%" pathname))
     236        (delete-directory pathname)
     237        ))))
    197238
    198239#-(or allegro clisp lispworks windows)
     
    259300     (= (length list) 1)
    260301     (pathnames-equal-p (car list) *this-file*)))
     302  t)
     303
     304(deftest directory.2
     305  (let* ((tmp (make-temporary-filename *this-directory*))
     306         (directory-namestring (concatenate 'string (namestring tmp) "/"))
     307         (directory-pathname (pathname directory-namestring)))
     308    (unwind-protect
     309        (progn
     310          (make-directory directory-pathname)
     311          (let ((file-pathname (make-pathname :name "foo" :defaults directory-pathname)))
     312            (touch file-pathname)
     313            (equal
     314             (directory (make-pathname :name :wild :defaults directory-pathname))
     315             (list file-pathname))))
     316      (delete-directory-and-files directory-pathname)))
    261317  t)
    262318
     
    389445  t nil)
    390446
     447;; Case 2: the directory in question does not exist.
    391448(deftest ensure-directories-exist.3
    392449  (let* ((tmp (make-temporary-filename *this-directory*))
Note: See TracChangeset for help on using the changeset viewer.