From ddc29a782eac30fcf4ff1f07677aa2896dc140e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 11 Nov 2012 22:33:28 +0100 Subject: Move base32 code to (guix base32). * guix/utils.scm (bytevector-quintet-ref, bytevector-quintet-ref-right, bytevector-quintet-length, bytevector-quintet-fold, bytevector-quintet-fold-right, make-bytevector->base32-string, %nix-base32-chars, %rfc4648-base32-chars, bytevector->base32-string, bytevector->nix-base32-string, bytevector-quintet-set!, bytevector-quintet-set-right!, base32-string-unfold, base32-string-unfold-right, make-base32-string->bytevector, base32-string->bytevector, nix-base32-string->bytevector): Move to... * guix/base32.scm: ... here. New file. * tests/utils.scm (%nix-hash, "bytevector->base32-string", "base32-string->bytevector", "nix-base32-string->bytevector", "sha256 & bytevector->base32-string"): Move to... * tests/base32.scm: ... here. New file * guix-download.in, guix/derivations.scm, guix/packages.scm, guix/snix.scm, tests/builders.scm, tests/derivations.scm: Adjust accordingly. * guix.scm (%public-modules): Add `base32'. --- tests/base32.scm | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++ tests/builders.scm | 1 + tests/derivations.scm | 1 + tests/utils.scm | 58 -------------------------------- 4 files changed, 95 insertions(+), 58 deletions(-) create mode 100644 tests/base32.scm (limited to 'tests') diff --git a/tests/base32.scm b/tests/base32.scm new file mode 100644 index 0000000000..b8b9ebb0dd --- /dev/null +++ b/tests/base32.scm @@ -0,0 +1,93 @@ +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Ludovic Courtès +;;; +;;; This file is part of Guix. +;;; +;;; 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. +;;; +;;; 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 Guix. If not, see . + +(define-module (test-base32) + #:use-module (guix base32) + #:use-module (guix utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 popen) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports)) + +;; Test the (guix base32) module. + +(define %nix-hash + (or (getenv "NIX_HASH") + "nix-hash")) + +(test-begin "base32") + +(test-assert "bytevector->base32-string" + (fold (lambda (bv expected result) + (and result + (string=? (bytevector->base32-string bv) + expected))) + #t + + ;; Examples from RFC 4648. + (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")) + '("" + "my" + "mzxq" + "mzxw6" + "mzxw6yq" + "mzxw6ytb" + "mzxw6ytboi"))) + +(test-assert "base32-string->bytevector" + (every (lambda (bv) + (equal? (base32-string->bytevector + (bytevector->base32-string bv)) + bv)) + ;; Examples from RFC 4648. + (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) + +(test-assert "nix-base32-string->bytevector" + (every (lambda (bv) + (equal? (nix-base32-string->bytevector + (bytevector->nix-base32-string bv)) + bv)) + ;; Examples from RFC 4648. + (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) + +;; The following tests requires `nix-hash' in $PATH. +(test-skip (if (false-if-exception (system* %nix-hash "--version")) + 0 + 1)) + +(test-assert "sha256 & bytevector->nix-base32-string" + (let ((file (search-path %load-path "tests/test.drv"))) + (equal? (bytevector->nix-base32-string + (sha256 (call-with-input-file file get-bytevector-all))) + (let* ((c (format #f "~a --type sha256 --base32 --flat \"~a\"" + %nix-hash file)) + (p (open-input-pipe c)) + (l (read-line p))) + (close-pipe p) + l)))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'test-assert 'scheme-indent-function 1) +;;; End: diff --git a/tests/builders.scm b/tests/builders.scm index 8b0fa117a9..d9dc5afa20 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -23,6 +23,7 @@ #:use-module (guix build-system gnu) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix base32) #:use-module (guix derivations) #:use-module ((guix packages) #:select (package-derivation)) #:use-module (distro packages bootstrap) diff --git a/tests/derivations.scm b/tests/derivations.scm index 01ede11af0..618a7c4b96 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -21,6 +21,7 @@ #:use-module (guix derivations) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix base32) #:use-module ((guix packages) #:select (package-derivation)) #:use-module (distro packages bootstrap) #:use-module (srfi srfi-1) diff --git a/tests/utils.scm b/tests/utils.scm index 1ced410d41..0a6e8a0833 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -16,59 +16,17 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Guix. If not, see . - (define-module (test-utils) #:use-module (guix utils) #:use-module ((guix store) #:select (store-path-package-name)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 popen) #:use-module (ice-9 match)) -(define %nix-hash - (or (getenv "NIX_HASH") - "nix-hash")) - (test-begin "utils") -(test-assert "bytevector->base32-string" - (fold (lambda (bv expected result) - (and result - (string=? (bytevector->base32-string bv) - expected))) - #t - - ;; Examples from RFC 4648. - (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")) - '("" - "my" - "mzxq" - "mzxw6" - "mzxw6yq" - "mzxw6ytb" - "mzxw6ytboi"))) - -(test-assert "base32-string->bytevector" - (every (lambda (bv) - (equal? (base32-string->bytevector - (bytevector->base32-string bv)) - bv)) - ;; Examples from RFC 4648. - (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) - -(test-assert "nix-base32-string->bytevector" - (every (lambda (bv) - (equal? (nix-base32-string->bytevector - (bytevector->nix-base32-string bv)) - bv)) - ;; Examples from RFC 4648. - (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) - (test-assert "bytevector->base16-string->bytevector" (every (lambda (bv) (equal? (base16-string->bytevector @@ -76,22 +34,6 @@ bv)) (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) -;; The following tests requires `nix-hash' in $PATH. -(test-skip (if (false-if-exception (system* %nix-hash "--version")) - 0 - 1)) - -(test-assert "sha256 & bytevector->nix-base32-string" - (let ((file (search-path %load-path "tests/test.drv"))) - (equal? (bytevector->nix-base32-string - (sha256 (call-with-input-file file get-bytevector-all))) - (let* ((c (format #f "~a --type sha256 --base32 --flat \"~a\"" - %nix-hash file)) - (p (open-input-pipe c)) - (l (read-line p))) - (close-pipe p) - l)))) - (test-assert "gnu-triplet->nix-system" (let ((samples '(("i586-gnu0.3" "i686-gnu") ("x86_64-unknown-linux-gnu" "x86_64-linux") -- cgit v1.2.3