aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-base64)
  #:use-module (guix base64)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-64))

(define (string->base64 str)
  (base64-encode (string->utf8 str)))

;;; Test vectors from <https://tools.ietf.org/rfc/rfc4648.txt>.

(test-begin "base64")

(test-equal "empty string"
  (string->base64 "")
  "")

(test-equal "f"
  (string->base64 "f")
  "Zg==")

(test-equal "fo"
  (string->base64 "fo")
  "Zm8=")

(test-equal "foo"
  (string->base64 "foo")
  "Zm9v")

(test-equal "foob"
  (string->base64 "foob")
  "Zm9vYg==")

(test-equal "fooba"
  (string->base64 "fooba")
  "Zm9vYmE=")

(test-equal "foobar"
  (string->base64 "foobar")
  "Zm9vYmFy")

(test-end "base64")
t* ((url '("http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz" "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")) (hash (nix-base32-string->bytevector "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) (drv (url-fetch* %store url 'sha256 hash #:guile %bootstrap-guile)) (out-path (derivation->output-path drv))) (and (build-derivations %store (list drv)) (file-exists? out-path) (valid-path? %store out-path)))) (test-assert "url-fetch, file" (let* ((file (search-path %load-path "guix.scm")) (hash (call-with-input-file file port-sha256)) (out (url-fetch* %store file 'sha256 hash))) (and (file-exists? out) (valid-path? %store out)))) (test-assert "url-fetch, file URI" (let* ((file (search-path %load-path "guix.scm")) (hash (call-with-input-file file port-sha256)) (out (url-fetch* %store (string-append "file://" (canonicalize-path file)) 'sha256 hash))) (and (file-exists? out) (valid-path? %store out)))) (test-equal "git-fetch, file URI" '("." ".." "a.txt" "b.scm") (let ((nonce (random-text))) (with-temporary-git-repository directory `((add "a.txt" ,nonce) (add "b.scm" "#t") (commit "Commit.") (tag "v1.0.0" "The tag.")) (run-with-store %store (mlet* %store-monad ((hash -> (file-hash* directory #:algorithm (hash-algorithm sha256) #:recursive? #t)) (drv (git-fetch (git-reference (url (string-append "file://" directory)) (commit "v1.0.0")) 'sha256 hash "git-fetch-test"))) (mbegin %store-monad (built-derivations (list drv)) (return (scandir (derivation->output-path drv))))))))) (test-assert "gnu-build-system" (build-system? gnu-build-system)) (define unpack (assoc-ref %standard-phases 'unpack)) (define compressors '(("gzip" . "gz") ("xz" . "xz") ("bzip2" . "bz2") (#f . #f))) (for-each (match-lambda ((comp . ext) (unless (network-reachable?) (test-skip 1)) ;for bootstrap binaries (test-equal (string-append "gnu-build-system unpack phase, " "single file (compression: " (if comp comp "None") ")") "expected text" (let*-values (((name) "test") ((compressed-name) (if ext (string-append name "." ext) name)) ((file hash) (test-file %store compressed-name "expected text"))) (call-with-temporary-directory (lambda (dir) (with-directory-excursion dir (unpack #:source file) (call-with-input-file name get-string-all)))))))) compressors) ;;; ;;; Test the sanity-check phase of the Python build system. ;;; (define* (make-python-dummy name #:key (setup-py-extra "") (init-py "") (use-setuptools? #t)) (dummy-package (string-append "python-dummy-" name) (version "0.1") (build-system python-build-system) (arguments `(#:tests? #f #:use-setuptools? ,use-setuptools? #:phases (modify-phases %standard-phases (replace 'unpack (lambda _ (mkdir-p "dummy") (with-output-to-file "dummy/__init__.py" (lambda _ (display ,init-py))) (with-output-to-file "setup.py" (lambda _ (format #t "\ ~a setup( name='dummy-~a', version='0.1', packages=['dummy'], ~a )" (if ,use-setuptools? "from setuptools import setup" "from distutils.core import setup") ,name ,setup-py-extra)))))))))) (define python-dummy-ok (make-python-dummy "ok")) ;; distutil won't install any metadata, so make sure our script does not fail ;; on a otherwise fine package. (define python-dummy-no-setuptools (make-python-dummy "no-setuptools" #:use-setuptools? #f)) (define python-dummy-fail-requirements (make-python-dummy "fail-requirements" #:setup-py-extra "install_requires=['nonexistent'],")) (define python-dummy-fail-import (make-python-dummy "fail-import" #:init-py "import nonexistent")) (define python-dummy-fail-console-script (make-python-dummy "fail-console-script" #:setup-py-extra (string-append "entry_points={'console_scripts': " "['broken = dummy:nonexistent']},"))) (define (check-build-success store p) (unless store (test-skip 1)) (test-assert (string-append "python-build-system: " (package-name p)) (let* ((drv (package-derivation store p))) (build-derivations store (list drv))))) (define (check-build-failure store p) (unless store (test-skip 1)) (test-assert (string-append "python-build-system: " (package-name p)) (let ((drv (package-derivation store p))) (guard (c ((store-protocol-error? c) (pk 'failure c #t))) ;good! (build-derivations store (list drv)) #f)))) ;bad: it should have failed (with-external-store store (for-each (lambda (p) (check-build-success store p)) (list python-dummy-ok python-dummy-no-setuptools)) (for-each (lambda (p) (check-build-failure store p)) (list python-dummy-fail-requirements python-dummy-fail-import python-dummy-fail-console-script))) (test-end "builders")