ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

modules: Raise an error when a dependency could not be found.

Browse source 
* guix/modules.scm (&missing-dependency-error): New error condition.
(source-module-dependencies): Raise it when 'search-path' returns #f.
* tests/modules.scm ("&missing-dependency-error"): New test.
This commit is contained in:
Ludovic Courtès 2017-05-25 14:19:51 +02:00
parent 4862a98be4
commit bfe5264aa1
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 41 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
guix/modules.scm
View file

@ -20,8 +20,13 @@ (define-module (guix modules)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (source-module-closure #:export (missing-dependency-error?
missing-dependency-module
source-module-closure
live-module-closure live-module-closure
guix-module-name?)) guix-module-name?))
@ -35,6 +40,11 @@ (define-module (guix modules)
;;; ;;;
;;; Code: ;;; Code:
;; The error corresponding to a missing module.
(define-condition-type &missing-dependency-error &error
missing-dependency-error?
(module missing-dependency-module))
(define (colon-symbol? obj) (define (colon-symbol? obj)
"Return true if OBJ is a symbol that starts with a colon." "Return true if OBJ is a symbol that starts with a colon."
(and (symbol? obj) (and (symbol? obj)
@ -106,9 +116,12 @@ (define* (source-module-dependencies module #:optional (load-path %load-path))
"Return the modules used by MODULE by looking at its source code." "Return the modules used by MODULE by looking at its source code."
(if (member module %source-less-modules) (if (member module %source-less-modules)
'() '()
(module-file-dependencies (match (search-path load-path (module-name->file-name module))
(search-path load-path ((? string? file)
(module-name->file-name module))))) (module-file-dependencies file))
(#f
(raise (condition (&missing-dependency-error
(module module))))))))
(define* (module-closure modules (define* (module-closure modules
#:key #:key

25
tests/modules.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,7 +19,9 @@
(define-module (test-modules) (define-module (test-modules)
#:use-module (guix modules) #:use-module (guix modules)
#:use-module ((guix build-system gnu) #:select (%gnu-build-system-modules)) #:use-module ((guix build-system gnu) #:select (%gnu-build-system-modules))
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
(test-begin "modules") (test-begin "modules")
@ -42,4 +44,25 @@ (define-module (test-modules)
(live-module-closure '((gnu build vm))) (live-module-closure '((gnu build vm)))
(source-module-closure '((gnu build vm))))) (source-module-closure '((gnu build vm)))))
(test-equal "&missing-dependency-error"
'(something that does not exist)
(call-with-temporary-directory
(lambda (directory)
(call-with-output-file (string-append directory "/foobar.scm")
(lambda (port)
(write '(define-module (foobar)
#:use-module (something that does not exist))
port)))
(call-with-output-file (string-append directory "/baz.scm")
(lambda (port)
(write '(define-module (baz)
#:use-module (foobar))
port)))
(guard (c ((missing-dependency-error? c)
(missing-dependency-module c)))
(source-module-closure '((baz)) (list directory)
#:select? (const #t))))))
(test-end) (test-end)