utils.scm 1.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354
  1. ;;;; utils.scm -- tests for (cuirass utils) module
  2. ;;;
  3. ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
  4. ;;;
  5. ;;; This file is part of Cuirass.
  6. ;;;
  7. ;;; Cuirass is free software; you can redistribute it and/or modify it
  8. ;;; under the terms of the GNU General Public License as published by
  9. ;;; the Free Software Foundation; either version 3 of the License, or (at
  10. ;;; your option) any later version.
  11. ;;;
  12. ;;; Cuirass is distributed in the hope that it will be useful, but
  13. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;;; GNU General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
  19. (use-modules (cuirass utils)
  20. (srfi srfi-64))
  21. (define dir-1 (make-parameter ""))
  22. (define dir-2 (make-parameter ""))
  23. (test-begin "utils")
  24. (test-assert "alist?"
  25. (and (alist? '())
  26. (alist? '(("foo" 1 2)))
  27. (alist? '(("foo" . 1)
  28. ("bar" . 2)))
  29. (not (alist? 3))
  30. (not (alist? '(1 2 3)))
  31. (not (alist? 'foo))
  32. (not (alist? #:bar))))
  33. (test-assert "with-directory-excursion"
  34. (let ((old (getcwd))
  35. (tmp (tmpnam)))
  36. (dynamic-wind
  37. (λ ()
  38. (mkdir tmp))
  39. (λ ()
  40. (with-directory-excursion tmp
  41. (dir-1 (getcwd)))
  42. (dir-2 (getcwd))
  43. (and (string=? (dir-1) tmp)
  44. (string=? (dir-2) old)))
  45. (λ ()
  46. (rmdir tmp)))))
  47. (test-end)