diff options
| -rw-r--r-- | guix/discovery.scm | 6 | ||||
| -rw-r--r-- | guix/ui.scm | 39 | ||||
| -rw-r--r-- | tests/guix-build.sh | 12 |
3 files changed, 50 insertions, 7 deletions
diff --git a/guix/discovery.scm b/guix/discovery.scm index 86f20ec344..468b6c59de 100644 --- a/guix/discovery.scm +++ b/guix/discovery.scm @@ -106,14 +106,14 @@ name and the exception key and arguments." (string-length directory)) (filter-map (lambda (file) - (let* ((file (substring file prefix-len)) - (module (file-name->module-name file))) + (let* ((relative (string-drop file prefix-len)) + (module (file-name->module-name relative))) (catch #t (lambda () (resolve-interface module)) (lambda args ;; Report the error, but keep going. - (warn module args) + (warn file module args) #f)))) (scheme-files (if sub-directory (string-append directory "/" sub-directory) diff --git a/guix/ui.scm b/guix/ui.scm index 76f6fc8eed..1812b01272 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -311,6 +311,36 @@ arguments." (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?") (module-name module)))))))) +(define (check-module-matches-file module file) + "Check whether FILE starts with 'define-module MODULE' and print a hint if +it doesn't." + ;; This is a common mistake when people start writing their own package + ;; definitions and try loading them with 'guix build -L …', so help them + ;; diagnose the problem. + (define (hint) + (display-hint (format #f (G_ "File @file{~a} should probably start with: + +@example\n(define-module ~a)\n@end example") + file module))) + + (catch 'system-error + (lambda () + (let* ((sexp (call-with-input-file file read)) + (loc (and (pair? sexp) + (source-properties->location (source-properties sexp))))) + (match sexp + (('define-module (names ...) _ ...) + (unless (equal? module names) + (warning loc + (G_ "module name ~a does not match file name '~a'~%") + names (module->source-file-name module)) + (hint))) + ((? eof-object?) + (warning (G_ "~a: file is empty~%") file)) + (else + (hint))))) + (const #f))) + (define* (report-load-error file args #:optional frame) "Report the failure to load FILE, a user-provided Scheme file. ARGS is the list of arguments received by the 'throw' handler." @@ -352,13 +382,13 @@ ARGS is the list of arguments received by the 'throw' handler." ;; above and need to be printed with 'print-exception'. (print-exception (current-error-port) frame key args)))))) -(define (warn-about-load-error file args) ;FIXME: factorize with ↑ +(define (warn-about-load-error file module args) ;FIXME: factorize with ↑ "Report the failure to load FILE, a user-provided Scheme file, without exiting. ARGS is the list of arguments received by the 'throw' handler." (match args (('system-error . rest) (let ((err (system-error-errno args))) - (warning (G_ "failed to load '~a': ~a~%") file (strerror err)))) + (warning (G_ "failed to load '~a': ~a~%") module (strerror err)))) (('syntax-error proc message properties form . rest) (let ((loc (source-properties->location properties))) (warning loc (G_ "~a~%") message))) @@ -370,8 +400,9 @@ exiting. ARGS is the list of arguments received by the 'throw' handler." (warning (G_ "failed to load '~a': exception thrown: ~s~%") file obj))) ((error args ...) - (warning (G_ "failed to load '~a':~%") file) - (apply display-error #f (current-error-port) args)))) + (warning (G_ "failed to load '~a':~%") module) + (apply display-error #f (current-error-port) args) + (check-module-matches-file module file)))) (define (call-with-unbound-variable-handling thunk) (define tag diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 63a9fe68da..d16b92d189 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -164,6 +164,17 @@ grep "unbound" "$module_dir/err" # actual error grep "forget.*(gnu packages base)" "$module_dir/err" # hint rm -f "$module_dir"/* +# Wrong 'define-module' clause reported by 'warn-about-load-error'. +cat > "$module_dir/foo.scm" <<EOF +(define-module (something foo) + #:use-module (guix) + #:use-module (gnu)) +EOF +guix build guile-bootstrap -n 2> "$module_dir/err" +grep "does not match file name" "$module_dir/err" + +rm "$module_dir"/* + # Should all return valid log files. drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" @@ -265,6 +276,7 @@ cat > "$module_dir/gexp.scm"<<EOF EOF guix build --file="$module_dir/gexp.scm" -d guix build --file="$module_dir/gexp.scm" -d | grep 'gexp\.drv' +rm "$module_dir"/*.scm # Using 'GUIX_BUILD_OPTIONS'. GUIX_BUILD_OPTIONS="--dry-run --no-grafts" |