ui: 'warn-about-load-error' warns about file/module name mismatches.

* guix/discovery.scm (scheme-modules): Rename the inner 'file' to
'relative'.  Pass FILE as an addition argument to WARN.
* guix/ui.scm (warn-about-load-error): Add 'module' argument (actually,
what was called 'file' really contained a module name.)  Call
'check-module-matches-file' in the catch-all error case.
(check-module-matches-file): New procedure.
* tests/guix-build.sh: Test it.
This commit is contained in:
Ludovic Courtès 2019-07-19 23:48:09 +02:00
parent ddc586ea5c
commit a2a94b6e58
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 50 additions and 7 deletions

View File

@ -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)

View File

@ -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

View File

@ -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"