tests/discovery.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 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
  19 (define-module (test-discovery)
  20   #:use-module (guix discovery)
  21   #:use-module (guix build-system)
  22   #:use-module (guix utils)
  23   #:use-module (srfi srfi-64)
  24   #:use-module (ice-9 match))
  25
  26 (define %top-srcdir
  27   (dirname (search-path %load-path "guix.scm")))
  28
  29 (test-begin "discovery")
  30
  31 (test-assert "scheme-modules"
  32   (match (map module-name (scheme-modules %top-srcdir "guix/import"))
  33     ((('guix 'import _ ...) ..1)
  34      #t)))
  35
  36 (test-assert "scheme-modules recurses in symlinks to directories"
  37   (call-with-temporary-directory
  38    (lambda (directory)
  39      (mkdir (string-append directory "/guix"))
  40      (symlink (string-append %top-srcdir "/guix/import")
  41               (string-append directory "/guix/import"))
  42
  43      ;; DIRECTORY/guix/import is a symlink but we want to make sure
  44      ;; 'scheme-modules' recurses into it.
  45      (match (map module-name (scheme-modules directory))
  46        ((('guix 'import _ ...) ..1)
  47         #t)))))
  48
  49 (test-equal "scheme-modules, non-existent directory"
  50   '()
  51   (scheme-modules "/does/not/exist"))
  52
  53 (test-assert "all-modules"
  54   (match (map module-name
  55               (all-modules `((,%top-srcdir . "guix/build-system"))))
  56     ((('guix 'build-system names) ..1)
  57      names)))
  58
  59 (test-assert "fold-module-public-variables"
  60   (let ((modules (all-modules `((,%top-srcdir . "guix/build-system")))))
  61     (match (fold-module-public-variables (lambda (obj result)
  62                                            (if (build-system? obj)
  63                                                (cons obj result)
  64                                                result))
  65                                          '()
  66                                          modules)
  67       (((? build-system? bs) ..1)
  68        bs))))
  69
  70 (test-end "discovery")