ulthar.xyz > Repos

leibowitz

Experimental Common Lisp object storage abstraction for Unix file systems
About Files Commits git clone https://ulthar.xyz/repos/leibowitz/leibowitz.git

leibowitz/tests/utils.lisp

Download raw file: tests/utils.lisp

(in-package :leibowitz/tests)

(defmacro with-tmp-files ((&rest tmpfiles) &body body)
  `(let (,@(loop for var in tmpfiles
                 collect `(,var (uiop:tmpize-pathname
                                 #P"/tmp/leibowitz_test_tmpfile"))))
     (unwind-protect (progn ,@body)
       ,@(loop for var in tmpfiles
               collect `(delete-file ,var)))))

(defun mktmp (&optional (prefix #P"/tmp/") (type :file))
  "Create a temporary file in /tmp/, or under PREFIX if it's specified
and return the pathname.  Unlike `with-tmp-files', the caller is
responsible for cleanup."
  (assert (member type '(:file :dir :fifo)))
  (let ((path (merge-pathnames
               (format NIL "leibowitz_test_tmp~A-~A"
                       (string-downcase type) (random (expt 36 8)))
               prefix)))
    (case type
      (:file (osicat-posix:creat path osicat-posix:*default-open-mode*))
      (:dir  (ensure-directories-exist (format NIL "~A/" path)))
      (:fifo (osicat-posix:mkfifo path osicat-posix:*default-open-mode*)))
    path))

(defun unix-relative-path-to-test-tmpfile (abs-path)
  "Given an absolute path to a file, assemble and return a relative path
to it, with trails of .. marching up to root.  Obviously this is not a
pure function; output is implicitly a function of our Lisp process's
current working directory."
  (with-output-to-string (s)
    (loop with ndirs = (length (cdr (pathname-directory
                                     *default-pathname-defaults*)))
          for i from 1 upto ndirs
          if (= i ndirs) do (format s "..")
            else do (format s "../")
          finally (format s (namestring abs-path)))
    s))
Generated 2025-03-07 15:24:22 -0700 by RepoRat