mirror of https://notabug.org/mthl/cuirass.git
utils: Add 'alist?' procedure.
* src/cuirass/utils.scm (alist?): New procedure. * tests/utils.scm ("alist?"): New test.pull/3/head
parent
ac4512897c
commit
e58911de37
|
@ -20,7 +20,9 @@
|
||||||
|
|
||||||
(define-module (cuirass utils)
|
(define-module (cuirass utils)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
#:export (;; Procedures
|
#:export (;; Procedures
|
||||||
|
alist?
|
||||||
mkdir-p
|
mkdir-p
|
||||||
make-user-module
|
make-user-module
|
||||||
;; Macros.
|
;; Macros.
|
||||||
|
@ -30,6 +32,11 @@
|
||||||
(define-syntax-rule (λ* formals body ...)
|
(define-syntax-rule (λ* formals body ...)
|
||||||
(lambda* formals body ...))
|
(lambda* formals body ...))
|
||||||
|
|
||||||
|
(define (alist? obj)
|
||||||
|
"Return #t if OBJ is an alist."
|
||||||
|
(and (list? obj)
|
||||||
|
(every pair? obj)))
|
||||||
|
|
||||||
(define mkdir-p
|
(define mkdir-p
|
||||||
(let ((not-slash (char-set-complement (char-set #\/))))
|
(let ((not-slash (char-set-complement (char-set #\/))))
|
||||||
(λ* (dir #:optional mode)
|
(λ* (dir #:optional mode)
|
||||||
|
|
|
@ -25,6 +25,16 @@
|
||||||
|
|
||||||
(test-begin "utils")
|
(test-begin "utils")
|
||||||
|
|
||||||
|
(test-assert "alist?"
|
||||||
|
(and (alist? '())
|
||||||
|
(alist? '(("foo" 1 2)))
|
||||||
|
(alist? '(("foo" . 1)
|
||||||
|
("bar" . 2)))
|
||||||
|
(not (alist? 3))
|
||||||
|
(not (alist? '(1 2 3)))
|
||||||
|
(not (alist? 'foo))
|
||||||
|
(not (alist? #:bar))))
|
||||||
|
|
||||||
(test-assert "with-directory-excursion"
|
(test-assert "with-directory-excursion"
|
||||||
(let ((old (getcwd))
|
(let ((old (getcwd))
|
||||||
(tmp (tmpnam)))
|
(tmp (tmpnam)))
|
||||||
|
|
Loading…
Reference in New Issue