mirror of https://codeberg.org/glenneth/stash.git
83 lines
2.8 KiB
Scheme
83 lines
2.8 KiB
Scheme
;; test-helpers.scm --- Helper functions for Stash tests
|
|
|
|
(define-module (test-helpers)
|
|
#:use-module (ice-9 ftw)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (ice-9 rdelim)
|
|
#:use-module (srfi srfi-1)
|
|
#:export (with-temporary-directory
|
|
create-test-file
|
|
create-test-symlink
|
|
delete-directory-recursive
|
|
read-string))
|
|
|
|
;; Create a temporary directory and run thunk with it
|
|
(define-syntax-rule (with-temporary-directory dir-name body ...)
|
|
(let* ((tmp-dir (string-append (or (getenv "TMPDIR") "/tmp")
|
|
"/stash-test-"
|
|
(number->string (current-time))))
|
|
(dir-name tmp-dir))
|
|
(mkdir tmp-dir)
|
|
(dynamic-wind
|
|
(lambda () #t)
|
|
(lambda () body ...)
|
|
(lambda () (delete-directory-recursive tmp-dir)))))
|
|
|
|
;; Create a test file with optional content
|
|
(define* (create-test-file path #:optional (content "test content\n"))
|
|
(let ((dir (dirname path)))
|
|
(when (not (file-exists? dir))
|
|
(mkdir-p dir))
|
|
(with-output-to-file path
|
|
(lambda ()
|
|
(display content)))))
|
|
|
|
;; Create a test symlink
|
|
(define (create-test-symlink target link-name)
|
|
(let ((dir (dirname link-name)))
|
|
(when (not (file-exists? dir))
|
|
(mkdir-p dir))
|
|
(symlink target link-name)))
|
|
|
|
;; Helper function to create directories recursively
|
|
(define (mkdir-p dir)
|
|
(let loop ((components (filter (lambda (x) (not (string-null? x)))
|
|
(string-split dir #\/)))
|
|
(path (if (string-prefix? "/" dir) "/" "")))
|
|
(unless (null? components)
|
|
(let ((new-path (if (string=? path "/")
|
|
(string-append path (car components))
|
|
(if (string-null? path)
|
|
(car components)
|
|
(string-append path "/" (car components))))))
|
|
(when (not (file-exists? new-path))
|
|
(mkdir new-path))
|
|
(loop (cdr components) new-path)))))
|
|
|
|
;; Recursively delete a directory
|
|
(define (delete-directory-recursive dir)
|
|
(when (file-exists? dir)
|
|
(file-system-fold
|
|
(const #t) ; enter?
|
|
(lambda (path stat result) ; leaf
|
|
(delete-file path))
|
|
(const #t) ; down
|
|
(lambda (path stat result) ; up
|
|
(rmdir path))
|
|
(const #t) ; skip
|
|
(lambda (path stat errno result) ; error
|
|
(format (current-error-port)
|
|
"Warning: ~a: ~a~%"
|
|
path
|
|
(strerror errno)))
|
|
#t
|
|
dir)))
|
|
|
|
;; Read entire contents of current input port as a string
|
|
(define (read-string)
|
|
(let loop ((chars '()))
|
|
(let ((char (read-char)))
|
|
(if (eof-object? char)
|
|
(list->string (reverse chars))
|
|
(loop (cons char chars))))))
|