contrib/sb-posix/posix-tests.lisp

   1 (defpackage "SB-POSIX-TESTS"
   2   (:use "COMMON-LISP" "SB-RT"))
   3
   4 (in-package "SB-POSIX-TESTS")
   5
   6 (defvar *test-directory*
   7   (ensure-directories-exist
   8    (merge-pathnames (make-pathname :directory '(:relative "test-lab"))
   9                     (make-pathname :directory
  10                                    (pathname-directory *load-truename*)))))
  11
  12 (defvar *current-directory* *default-pathname-defaults*)
  13
  14 (defvar *this-file* *load-truename*)
  15
  16 (eval-when (:compile-toplevel :load-toplevel)
  17   (defconstant +mode-rwx-all+ (logior sb-posix::s-irusr sb-posix::s-iwusr sb-posix::s-ixusr
  18                                       sb-posix::s-irgrp sb-posix::s-iwgrp sb-posix::s-ixgrp
  19                                       sb-posix::s-iroth sb-posix::s-iwoth sb-posix::s-ixoth)))
  20 \f
  21 (deftest chdir.1
  22   (sb-posix:chdir *test-directory*)
  23   0)
  24
  25 (deftest chdir.2
  26   (sb-posix:chdir (namestring *test-directory*))
  27   0)
  28
  29 (deftest chdir.3
  30   (sb-posix:chdir "/")
  31   0)
  32
  33 (deftest chdir.4
  34   (sb-posix:chdir #p"/")
  35   0)
  36
  37 (deftest chdir.5
  38   (sb-posix:chdir *current-directory*)
  39   0)
  40
  41 (deftest chdir.error.1
  42   (let ((dne (make-pathname :directory '(:relative "chdir.does-not-exist"))))
  43     (handler-case
  44         (sb-posix:chdir (merge-pathnames dne *test-directory*))
  45       (sb-posix:syscall-error (c)
  46         (sb-posix:syscall-errno c))))
  47   #.sb-posix::enoent)
  48
  49 (deftest chdir.error.2
  50   (handler-case
  51       (sb-posix:chdir *this-file*)
  52     (sb-posix:syscall-error (c)
  53       (sb-posix:syscall-errno c)))
  54   #.sb-posix::enotdir)
  55 \f
  56 (deftest mkdir.1
  57   (let ((dne (make-pathname :directory '(:relative "mkdir.does-not-exist.1"))))
  58     (unwind-protect
  59          (sb-posix:mkdir (merge-pathnames dne *test-directory*) 0)
  60       ;; FIXME: no delete-directory in CL, but using our own operators
  61       ;; is probably not ideal
  62       (ignore-errors (sb-posix:rmdir (merge-pathnames dne *test-directory*)))))
  63   0)
  64
  65 (deftest mkdir.2
  66   (let ((dne (make-pathname :directory '(:relative "mkdir.does-not-exist.2"))))
  67     (unwind-protect
  68          (sb-posix:mkdir (namestring (merge-pathnames dne *test-directory*)) 0)
  69       (ignore-errors (sb-posix:rmdir (merge-pathnames dne *test-directory*)))))
  70   0)
  71
  72 (deftest mkdir.error.1
  73   (handler-case
  74       (sb-posix:mkdir *test-directory* 0)
  75     (sb-posix:syscall-error (c)
  76       (sb-posix:syscall-errno c)))
  77   #.sb-posix::eexist)
  78
  79 (deftest mkdir.error.2
  80   (handler-case
  81       (sb-posix:mkdir "/" 0)
  82     (sb-posix:syscall-error (c)
  83       (sb-posix:syscall-errno c)))
  84   #.sb-posix::eexist)
  85
  86 (deftest mkdir.error.3
  87   (handler-case
  88       (sb-posix:mkdir "/almost-certainly-does-not-exist" 0)
  89     (sb-posix:syscall-error (c)
  90       (sb-posix:syscall-errno c)))
  91   #.sb-posix::eacces)
  92 \f
  93 (deftest rmdir.1
  94   (let ((dne (make-pathname :directory '(:relative "rmdir.does-not-exist.1"))))
  95     (ensure-directories-exist (merge-pathnames dne *test-directory*))
  96     (sb-posix:rmdir (merge-pathnames dne *test-directory*)))
  97   0)
  98
  99 (deftest rmdir.2
 100   (let ((dne (make-pathname :directory '(:relative "rmdir.does-not-exist.2"))))
 101     (ensure-directories-exist (merge-pathnames dne *test-directory*))
 102     (sb-posix:rmdir (namestring (merge-pathnames dne *test-directory*))))
 103   0)
 104
 105 (deftest rmdir.error.1
 106   (let ((dne (make-pathname :directory '(:relative "rmdir.dne.error.1"))))
 107     (handler-case
 108         (sb-posix:rmdir (merge-pathnames dne *test-directory*))
 109       (sb-posix:syscall-error (c)
 110         (sb-posix:syscall-errno c))))
 111   #.sb-posix::enoent)
 112
 113 (deftest rmdir.error.2
 114   (handler-case
 115       (sb-posix:rmdir *this-file*)
 116     (sb-posix:syscall-error (c)
 117       (sb-posix:syscall-errno c)))
 118   #.sb-posix::enotdir)
 119
 120 #-sunos ; Apparently gives EINVAL on SunOS 8, which doesn't make sense
 121 (deftest rmdir.error.3
 122   (handler-case
 123       (sb-posix:rmdir "/")
 124     (sb-posix:syscall-error (c)
 125       (sb-posix:syscall-errno c)))
 126   #.sb-posix::ebusy)
 127
 128 (deftest rmdir.error.4
 129   (let* ((dir (ensure-directories-exist
 130                (merge-pathnames
 131                 (make-pathname :directory '(:relative "rmdir.error.4"))
 132                 *test-directory*)))
 133          (file (make-pathname :name "foo" :defaults dir)))
 134     (with-open-file (s file :direction :output)
 135       (write "" :stream s))
 136     (handler-case
 137         (sb-posix:rmdir dir)
 138       (sb-posix:syscall-error (c)
 139         (delete-file file)
 140         (sb-posix:rmdir dir)
 141         (let ((errno (sb-posix:syscall-errno c)))
 142           ;; documented by POSIX
 143           (or (= errno sb-posix::eexist) (= errno sb-posix::enotempty))))))
 144   t)
 145
 146 (deftest rmdir.error.5
 147   (let* ((dir (merge-pathnames
 148                (make-pathname :directory '(:relative "rmdir.error.5"))
 149                *test-directory*))
 150          (dir2 (merge-pathnames
 151                 (make-pathname :directory '(:relative "unremovable"))
 152                 dir)))
 153     (sb-posix:mkdir dir +mode-rwx-all+)
 154     (sb-posix:mkdir dir2 +mode-rwx-all+)
 155     (sb-posix:chmod dir 0)
 156     (handler-case
 157         (sb-posix:rmdir dir2)
 158       (sb-posix:syscall-error (c)
 159         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
 160         (sb-posix:rmdir dir2)
 161         (sb-posix:rmdir dir)
 162         (sb-posix:syscall-errno c))))
 163   #.sb-posix::eacces)
 164 \f
 165 (deftest stat.1
 166   (let* ((stat (sb-posix:stat *test-directory*))
 167          (mode (sb-posix::stat-mode stat)))
 168     ;; FIXME: Ugly ::s everywhere
 169     (logand mode (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)))
 170   #.(logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
 171
 172 (deftest stat.2
 173   (let* ((stat (sb-posix:stat "/"))
 174          (mode (sb-posix::stat-mode stat)))
 175     ;; it's logically possible for / to be writeable by others... but
 176     ;; if it is, either someone is playing with strange security
 177     ;; modules or they want to know about it anyway.
 178     (logand mode sb-posix::s-iwoth))
 179   0)
 180
 181 (deftest stat.3
 182   (let* ((now (get-universal-time))
 183          ;; FIXME: (encode-universal-time 00 00 00 01 01 1970)
 184          (unix-now (- now 2208988800))
 185          (stat (sb-posix:stat *test-directory*))
 186          (atime (sb-posix::stat-atime stat)))
 187     ;; FIXME: breaks if mounted noatime :-(
 188     (< (- atime unix-now) 10))
 189   t)
 190
 191 ;;; FIXME: add tests for carrying a stat structure around in the
 192 ;;; optional argument to SB-POSIX:STAT
 193
 194 (deftest stat.error.1
 195   (handler-case (sb-posix:stat "")
 196     (sb-posix:syscall-error (c)
 197       (sb-posix:syscall-errno c)))
 198   #.sb-posix::enoent)
 199
 200 (deftest stat.error.2
 201   (let* ((dir (merge-pathnames
 202                (make-pathname :directory '(:relative "stat.error.2"))
 203                *test-directory*))
 204          (file (merge-pathnames
 205                 (make-pathname :name "unstatable")
 206                 dir)))
 207     (sb-posix:mkdir dir +mode-rwx-all+)
 208     (with-open-file (s file :direction :output)
 209       (write "" :stream s))
 210     (sb-posix:chmod dir 0)
 211     (handler-case
 212         (sb-posix:stat file)
 213       (sb-posix:syscall-error (c)
 214         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
 215         (sb-posix:unlink file)
 216         (sb-posix:rmdir dir)
 217         (sb-posix:syscall-errno c))))
 218   #.sb-posix::eacces)
 219 \f
 220 ;;; stat-mode tests
 221 (defmacro with-stat-mode ((mode pathname) &body body)
 222   (let ((stat (gensym)))
 223     `(let* ((,stat (sb-posix:stat ,pathname))
 224             (,mode (sb-posix::stat-mode ,stat)))
 225        ,@body)))
 226
 227 (defmacro with-lstat-mode ((mode pathname) &body body)
 228   (let ((stat (gensym)))
 229     `(let* ((,stat (sb-posix:lstat ,pathname))
 230             (,mode (sb-posix::stat-mode ,stat)))
 231        ,@body)))
 232
 233 (deftest stat-mode.1
 234   (with-stat-mode (mode *test-directory*)
 235     (sb-posix:s-isreg mode))
 236   nil)
 237
 238 (deftest stat-mode.2
 239   (with-stat-mode (mode *test-directory*)
 240     (sb-posix:s-isdir mode))
 241   t)
 242
 243 (deftest stat-mode.3
 244   (with-stat-mode (mode *test-directory*)
 245     (sb-posix:s-ischr mode))
 246   nil)
 247
 248 (deftest stat-mode.4
 249   (with-stat-mode (mode *test-directory*)
 250     (sb-posix:s-isblk mode))
 251   nil)
 252
 253 (deftest stat-mode.5
 254   (with-stat-mode (mode *test-directory*)
 255     (sb-posix:s-isfifo mode))
 256   nil)
 257
 258 (deftest stat-mode.6
 259   (with-stat-mode (mode *test-directory*)
 260     (sb-posix:s-issock mode))
 261   nil)
 262
 263 (deftest stat-mode.7
 264   (let ((link-pathname (make-pathname :name "stat-mode.7"
 265                                       :defaults *test-directory*)))
 266     (unwind-protect
 267          (progn
 268            (sb-posix:symlink *test-directory* link-pathname)
 269            (with-lstat-mode (mode link-pathname)
 270              (sb-posix:s-islnk mode)))
 271       (ignore-errors (sb-posix:unlink link-pathname))))
 272   t)
 273
 274 (deftest stat-mode.8
 275   (let ((pathname (make-pathname :name "stat-mode.8"
 276                                  :defaults *test-directory*)))
 277     (unwind-protect
 278          (progn
 279            (with-open-file (out pathname :direction :output)
 280              (write-line "test" out))
 281            (with-stat-mode (mode pathname)
 282              (sb-posix:s-isreg mode)))
 283       (ignore-errors (delete-file pathname))))
 284   t)
 285 \f
 286 ;;; see comment in filename's designator definition, in macros.lisp
 287 (deftest filename-designator.1
 288   (let ((file (format nil "~A/[foo].txt" (namestring *test-directory*))))
 289     ;; creat() with a string as argument
 290     (sb-posix:creat file 0)
 291     ;; if this test fails, it will probably be with
 292     ;; "System call error 2 (No such file or directory)"
 293     (let ((*default-pathname-defaults* *test-directory*))
 294       (sb-posix:unlink (car (directory "*.txt")))))
 295   0)
 296