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.6
  42   (sb-posix:chdir "/../")
  43   0)
  44
  45 (deftest chdir.7
  46   (sb-posix:chdir #p"/../")
  47   0)
  48
  49 (deftest chdir.8
  50   (sb-posix:chdir (make-pathname :directory '(:absolute :up)))
  51   0)
  52
  53 (deftest chdir.error.1
  54   (let ((dne (make-pathname :directory '(:relative "chdir.does-not-exist"))))
  55     (handler-case
  56         (sb-posix:chdir (merge-pathnames dne *test-directory*))
  57       (sb-posix:syscall-error (c)
  58         (sb-posix:syscall-errno c))))
  59   #.sb-posix::enoent)
  60
  61 (deftest chdir.error.2
  62   (handler-case
  63       (sb-posix:chdir *this-file*)
  64     (sb-posix:syscall-error (c)
  65       (sb-posix:syscall-errno c)))
  66   #.sb-posix::enotdir)
  67 \f
  68 (deftest mkdir.1
  69   (let ((dne (make-pathname :directory '(:relative "mkdir.does-not-exist.1"))))
  70     (unwind-protect
  71          (sb-posix:mkdir (merge-pathnames dne *test-directory*) 0)
  72       ;; FIXME: no delete-directory in CL, but using our own operators
  73       ;; is probably not ideal
  74       (ignore-errors (sb-posix:rmdir (merge-pathnames dne *test-directory*)))))
  75   0)
  76
  77 (deftest mkdir.2
  78   (let ((dne (make-pathname :directory '(:relative "mkdir.does-not-exist.2"))))
  79     (unwind-protect
  80          (sb-posix:mkdir (namestring (merge-pathnames dne *test-directory*)) 0)
  81       (ignore-errors (sb-posix:rmdir (merge-pathnames dne *test-directory*)))))
  82   0)
  83
  84 (deftest mkdir.error.1
  85   (handler-case
  86       (sb-posix:mkdir *test-directory* 0)
  87     (sb-posix:syscall-error (c)
  88       (sb-posix:syscall-errno c)))
  89   #.sb-posix::eexist)
  90
  91 (deftest mkdir.error.2
  92   (handler-case
  93       (sb-posix:mkdir "/" 0)
  94     (sb-posix:syscall-error (c)
  95       (sb-posix:syscall-errno c)))
  96   #.sb-posix::eexist)
  97
  98 (deftest mkdir.error.3
  99   (let* ((dir (merge-pathnames
 100                (make-pathname :directory '(:relative "mkdir.error.3"))
 101                *test-directory*))
 102          (dir2 (merge-pathnames
 103                 (make-pathname :directory '(:relative "does-not-exist"))
 104                 dir)))
 105     (sb-posix:mkdir dir 0)
 106     (handler-case
 107         (sb-posix:mkdir dir2 0)
 108       (sb-posix:syscall-error (c)
 109         (sb-posix:rmdir dir)
 110         (sb-posix:syscall-errno c))
 111       (:no-error (result)
 112         (sb-posix:rmdir dir2)
 113         (sb-posix:rmdir dir)
 114         result)))
 115   #.sb-posix::eacces)
 116 \f
 117 (deftest rmdir.1
 118   (let ((dne (make-pathname :directory '(:relative "rmdir.does-not-exist.1"))))
 119     (ensure-directories-exist (merge-pathnames dne *test-directory*))
 120     (sb-posix:rmdir (merge-pathnames dne *test-directory*)))
 121   0)
 122
 123 (deftest rmdir.2
 124   (let ((dne (make-pathname :directory '(:relative "rmdir.does-not-exist.2"))))
 125     (ensure-directories-exist (merge-pathnames dne *test-directory*))
 126     (sb-posix:rmdir (namestring (merge-pathnames dne *test-directory*))))
 127   0)
 128
 129 (deftest rmdir.error.1
 130   (let ((dne (make-pathname :directory '(:relative "rmdir.dne.error.1"))))
 131     (handler-case
 132         (sb-posix:rmdir (merge-pathnames dne *test-directory*))
 133       (sb-posix:syscall-error (c)
 134         (sb-posix:syscall-errno c))))
 135   #.sb-posix::enoent)
 136
 137 (deftest rmdir.error.2
 138   (handler-case
 139       (sb-posix:rmdir *this-file*)
 140     (sb-posix:syscall-error (c)
 141       (sb-posix:syscall-errno c)))
 142   #.sb-posix::enotdir)
 143
 144 (deftest rmdir.error.3
 145   (handler-case
 146       (sb-posix:rmdir "/")
 147     (sb-posix:syscall-error (c)
 148       (sb-posix:syscall-errno c)))
 149   #.sb-posix::ebusy)
 150
 151 (deftest rmdir.error.4
 152   (let* ((dir (ensure-directories-exist
 153                (merge-pathnames
 154                 (make-pathname :directory '(:relative "rmdir.error.4"))
 155                 *test-directory*)))
 156          (file (make-pathname :name "foo" :defaults dir)))
 157     (with-open-file (s file :direction :output)
 158       (write "" :stream s))
 159     (handler-case
 160         (sb-posix:rmdir dir)
 161       (sb-posix:syscall-error (c)
 162         (delete-file file)
 163         (sb-posix:rmdir dir)
 164         (let ((errno (sb-posix:syscall-errno c)))
 165           ;; documented by POSIX
 166           (or (= errno sb-posix::eexist) (= errno sb-posix::enotempty))))))
 167   t)
 168
 169 (deftest rmdir.error.5
 170   (let* ((dir (merge-pathnames
 171                (make-pathname :directory '(:relative "rmdir.error.5"))
 172                *test-directory*))
 173          (dir2 (merge-pathnames
 174                 (make-pathname :directory '(:relative "unremovable"))
 175                 dir)))
 176     (sb-posix:mkdir dir +mode-rwx-all+)
 177     (sb-posix:mkdir dir2 +mode-rwx-all+)
 178     (sb-posix:chmod dir 0)
 179     (handler-case
 180         (sb-posix:rmdir dir2)
 181       (sb-posix:syscall-error (c)
 182         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
 183         (sb-posix:rmdir dir2)
 184         (sb-posix:rmdir dir)
 185         (sb-posix:syscall-errno c))
 186       (:no-error (result)
 187         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
 188         (sb-posix:rmdir dir)
 189         result)))
 190   #.sb-posix::eacces)
 191 \f
 192 (deftest stat.1
 193   (let* ((stat (sb-posix:stat *test-directory*))
 194          (mode (sb-posix::stat-mode stat)))
 195     ;; FIXME: Ugly ::s everywhere
 196     (logand mode (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)))
 197   #.(logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
 198
 199 (deftest stat.2
 200   (let* ((stat (sb-posix:stat "/"))
 201          (mode (sb-posix::stat-mode stat)))
 202     ;; it's logically possible for / to be writeable by others... but
 203     ;; if it is, either someone is playing with strange security
 204     ;; modules or they want to know about it anyway.
 205     (logand mode sb-posix::s-iwoth))
 206   0)
 207
 208 (deftest stat.3
 209   (let* ((now (get-universal-time))
 210          ;; FIXME: (encode-universal-time 00 00 00 01 01 1970)
 211          (unix-now (- now 2208988800))
 212          (stat (sb-posix:stat *test-directory*))
 213          (atime (sb-posix::stat-atime stat)))
 214     ;; FIXME: breaks if mounted noatime :-(
 215     (< (- atime unix-now) 10))
 216   t)
 217
 218 (deftest stat.4
 219   (let* ((stat (sb-posix:stat (make-pathname :directory '(:absolute :up))))
 220          (mode (sb-posix::stat-mode stat)))
 221     ;; it's logically possible for / to be writeable by others... but
 222     ;; if it is, either someone is playing with strange security
 223     ;; modules or they want to know about it anyway.
 224     (logand mode sb-posix::s-iwoth))
 225   0)
 226
 227 ;;; FIXME: add tests for carrying a stat structure around in the
 228 ;;; optional argument to SB-POSIX:STAT
 229
 230 (deftest stat.error.1
 231   (handler-case (sb-posix:stat "")
 232     (sb-posix:syscall-error (c)
 233       (sb-posix:syscall-errno c)))
 234   #.sb-posix::enoent)
 235
 236 (deftest stat.error.2
 237   (let* ((dir (merge-pathnames
 238                (make-pathname :directory '(:relative "stat.error.2"))
 239                *test-directory*))
 240          (file (merge-pathnames
 241                 (make-pathname :name "unstatable")
 242                 dir)))
 243     (sb-posix:mkdir dir +mode-rwx-all+)
 244     (with-open-file (s file :direction :output)
 245       (write "" :stream s))
 246     (sb-posix:chmod dir 0)
 247     (handler-case
 248         (sb-posix:stat file)
 249       (sb-posix:syscall-error (c)
 250         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
 251         (sb-posix:unlink file)
 252         (sb-posix:rmdir dir)
 253         (sb-posix:syscall-errno c))
 254       (:no-error (result)
 255         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
 256         (sb-posix:unlink file)
 257         (sb-posix:rmdir dir)
 258         result)))
 259   #.sb-posix::eacces)
 260 \f
 261 ;;; stat-mode tests
 262 (defmacro with-stat-mode ((mode pathname) &body body)
 263   (let ((stat (gensym)))
 264     `(let* ((,stat (sb-posix:stat ,pathname))
 265             (,mode (sb-posix::stat-mode ,stat)))
 266        ,@body)))
 267
 268 (defmacro with-lstat-mode ((mode pathname) &body body)
 269   (let ((stat (gensym)))
 270     `(let* ((,stat (sb-posix:lstat ,pathname))
 271             (,mode (sb-posix::stat-mode ,stat)))
 272        ,@body)))
 273
 274 (deftest stat-mode.1
 275   (with-stat-mode (mode *test-directory*)
 276     (sb-posix:s-isreg mode))
 277   nil)
 278
 279 (deftest stat-mode.2
 280   (with-stat-mode (mode *test-directory*)
 281     (sb-posix:s-isdir mode))
 282   t)
 283
 284 (deftest stat-mode.3
 285   (with-stat-mode (mode *test-directory*)
 286     (sb-posix:s-ischr mode))
 287   nil)
 288
 289 (deftest stat-mode.4
 290   (with-stat-mode (mode *test-directory*)
 291     (sb-posix:s-isblk mode))
 292   nil)
 293
 294 (deftest stat-mode.5
 295   (with-stat-mode (mode *test-directory*)
 296     (sb-posix:s-isfifo mode))
 297   nil)
 298
 299 (deftest stat-mode.6
 300   (with-stat-mode (mode *test-directory*)
 301     (sb-posix:s-issock mode))
 302   nil)
 303
 304 (deftest stat-mode.7
 305   (let ((link-pathname (make-pathname :name "stat-mode.7"
 306                                       :defaults *test-directory*)))
 307     (unwind-protect
 308          (progn
 309            (sb-posix:symlink *test-directory* link-pathname)
 310            (with-lstat-mode (mode link-pathname)
 311              (sb-posix:s-islnk mode)))
 312       (ignore-errors (sb-posix:unlink link-pathname))))
 313   t)
 314
 315 (deftest stat-mode.8
 316   (let ((pathname (make-pathname :name "stat-mode.8"
 317                                  :defaults *test-directory*)))
 318     (unwind-protect
 319          (progn
 320            (with-open-file (out pathname :direction :output)
 321              (write-line "test" out))
 322            (with-stat-mode (mode pathname)
 323              (sb-posix:s-isreg mode)))
 324       (ignore-errors (delete-file pathname))))
 325   t)
 326 \f
 327 ;;; see comment in filename's designator definition, in macros.lisp
 328 (deftest filename-designator.1
 329   (let ((file (format nil "~A/[foo].txt" (namestring *test-directory*))))
 330     ;; creat() with a string as argument
 331     (sb-posix:creat file 0)
 332     ;; if this test fails, it will probably be with
 333     ;; "System call error 2 (No such file or directory)"
 334     (let ((*default-pathname-defaults* *test-directory*))
 335       (sb-posix:unlink (car (directory "*.txt")))))
 336   0)
 337 \f
 338 (deftest open.1
 339   (let ((fd (sb-posix:open *test-directory* sb-posix::o-rdonly)))
 340     (ignore-errors (sb-posix:close fd))
 341     (< fd 0))
 342   nil)
 343
 344 (deftest open.error.1
 345   (handler-case (sb-posix:open *test-directory* sb-posix::o-wronly)
 346     (sb-posix:syscall-error (c)
 347       (sb-posix:syscall-errno c)))
 348   #.sb-posix::eisdir)
 349
 350 (deftest fcntl.1
 351   (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
 352     (= (sb-posix:fcntl fd sb-posix::f-getfl) sb-posix::o-nonblock))
 353   t)