You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

71 lines
2.3 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2013, 2014 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 (guix tests)
  19. #:use-module (guix store)
  20. #:use-module (guix derivations)
  21. #:use-module (guix packages)
  22. #:use-module (gnu packages bootstrap)
  23. #:use-module (srfi srfi-34)
  24. #:use-module (rnrs bytevectors)
  25. #:export (open-connection-for-tests
  26. random-text
  27. random-bytevector))
  28. ;;; Commentary:
  29. ;;;
  30. ;;; This module provide shared infrastructure for the test suite. For
  31. ;;; internal use only.
  32. ;;;
  33. ;;; Code:
  34. (define (open-connection-for-tests)
  35. "Open a connection to the build daemon for tests purposes and return it."
  36. (guard (c ((nix-error? c)
  37. (format (current-error-port)
  38. "warning: build daemon error: ~s~%" c)
  39. #f))
  40. (let ((store (open-connection)))
  41. ;; Make sure we build everything by ourselves.
  42. (set-build-options store #:use-substitutes? #f)
  43. ;; Use the bootstrap Guile when running tests, so we don't end up
  44. ;; building everything in the temporary test store.
  45. (%guile-for-build (package-derivation store %bootstrap-guile))
  46. store)))
  47. (define %seed
  48. (seed->random-state (logxor (getpid) (car (gettimeofday)))))
  49. (define (random-text)
  50. "Return the hexadecimal representation of a random number."
  51. (number->string (random (expt 2 256) %seed) 16))
  52. (define (random-bytevector n)
  53. "Return a random bytevector of N bytes."
  54. (let ((bv (make-bytevector n)))
  55. (let loop ((i 0))
  56. (if (< i n)
  57. (begin
  58. (bytevector-u8-set! bv i (random 256 %seed))
  59. (loop (1+ i)))
  60. bv))))
  61. ;;; tests.scm ends here