scripts.scm 2.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (test-scripts)
  19. #:use-module (guix scripts)
  20. #:use-module ((guix scripts build)
  21. #:select (%standard-build-options))
  22. #:use-module (srfi srfi-64))
  23. ;; Test the (guix scripts) module.
  24. (define-syntax-rule (with-environment-variable variable value body ...)
  25. "Run BODY with VARIABLE set to VALUE."
  26. (let ((orig (getenv variable)))
  27. (dynamic-wind
  28. (lambda ()
  29. (setenv variable value))
  30. (lambda ()
  31. body ...)
  32. (lambda ()
  33. (if orig
  34. (setenv variable orig)
  35. (unsetenv variable))))))
  36. (test-begin "scripts")
  37. (test-equal "parse-command-line"
  38. '((argument . "bar") (argument . "foo")
  39. (cores . 10) ;takes precedence
  40. (substitutes? . #f) (keep-failed? . #t)
  41. (max-jobs . 77) (cores . 42))
  42. (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77"
  43. (parse-command-line '("--keep-failed" "--no-substitutes"
  44. "--cores=10" "foo" "bar")
  45. %standard-build-options
  46. (list '()))))
  47. (test-equal "parse-command-line and --no options"
  48. '((argument . "foo")
  49. (substitutes? . #f)) ;takes precedence
  50. (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
  51. (parse-command-line '("foo")
  52. %standard-build-options
  53. (list '((substitutes? . #t))))))
  54. (test-end "scripts")
  55. ;;; Local Variables:
  56. ;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
  57. ;;; End: