mirror of https://notabug.org/mthl/cuirass.git
Add test for 'with-directory-excursion'.
parent
2bace10106
commit
88e72887a0
|
@ -24,7 +24,8 @@ SCM_LOG_DRIVER = \
|
||||||
|
|
||||||
TESTS = \
|
TESTS = \
|
||||||
tests/base.scm \
|
tests/base.scm \
|
||||||
tests/database.scm
|
tests/database.scm \
|
||||||
|
tests/utils.scm
|
||||||
|
|
||||||
# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if
|
# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if
|
||||||
# $GUILE_LOAD_COMPILED_PATH contains $(cuirassmoduledir), we may find .go
|
# $GUILE_LOAD_COMPILED_PATH contains $(cuirassmoduledir), we may find .go
|
||||||
|
|
|
@ -0,0 +1,39 @@
|
||||||
|
;;;; utils.scm -- tests for (cuirass utils) module
|
||||||
|
;;;
|
||||||
|
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of Cuirass.
|
||||||
|
;;;
|
||||||
|
;;; Cuirass is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Cuirass is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(use-modules (cuirass utils)
|
||||||
|
(srfi srfi-64))
|
||||||
|
|
||||||
|
(define dir-1 (make-parameter ""))
|
||||||
|
(define dir-2 (make-parameter ""))
|
||||||
|
|
||||||
|
(test-assert "with-directory-excursion"
|
||||||
|
(let ((old (getcwd))
|
||||||
|
(tmp (tmpnam)))
|
||||||
|
(dynamic-wind
|
||||||
|
(λ ()
|
||||||
|
(mkdir tmp))
|
||||||
|
(λ ()
|
||||||
|
(with-directory-excursion tmp
|
||||||
|
(dir-1 (getcwd)))
|
||||||
|
(dir-2 (getcwd))
|
||||||
|
(and (string=? (dir-1) tmp)
|
||||||
|
(string=? (dir-2) old)))
|
||||||
|
(λ ()
|
||||||
|
(rmdir tmp)))))
|
Loading…
Reference in New Issue