Ludovic Courtès <[email protected]> writes: > Hi, > > Christopher Baines <[email protected]> skribis: > >> At some point, usually when extracting the information about lint >> warnings, package derivations or system tests, the inferior guix repl >> crashes. > > Could you come up with a simpler reproducer? What do we need to send to > the inferior to reach that crash?
I've attached a script that when run should reproduce the issue. I extracted the code relating to lint warnings from the Guix Data Service. The script attached runs this code twice against the inferior, once will often be enough to cause it to crash, but twice should reproduce it more reliably.
(use-modules (ice-9 match)
(guix inferior)
(guix channels)
(guix store))
(define (all-inferior-lint-warnings inf store)
(define locales
'("cs_CZ.utf8"
"da_DK.utf8"
"de_DE.utf8"
"eo_EO.utf8"
"es_ES.utf8"
"fr_FR.utf8"
"hu_HU.utf8"
"pl_PL.utf8"
"pt_BR.utf8"
;;"sr_SR.utf8"
"sv_SE.utf8"
"vi_VN.utf8"
"zh_CN.utf8"))
(define (lint-warnings-for-checker checker-name)
`(lambda (store)
(let* ((checker (find (lambda (checker)
(eq? (lint-checker-name checker)
',checker-name))
%local-checkers))
(check (lint-checker-check checker)))
(define lint-checker-requires-store?-defined?
(defined? 'lint-checker-requires-store?
(resolve-module '(guix lint))))
(define (process-lint-warning lint-warning)
(list
(match (lint-warning-location lint-warning)
(($ <location> file line column)
(list (if (string-prefix? "/gnu/store/" file)
;; Convert a string like
;;
/gnu/store/53xh0mpigin2rffg31s52x5dc08y0qmr-guix-module-union/share/guile/site/2.2/gnu/packages/xdisorg.scm
;;
;; This happens when the checker uses
;; package-field-location.
(string-join (drop (string-split file #\/) 8) "/")
file)
line
column)))
(let* ((source-locale "en_US.utf8")
(source-message
(begin
(setlocale LC_MESSAGES source-locale)
(lint-warning-message lint-warning)))
(messages-by-locale
(filter-map
(lambda (locale)
(catch 'system-error
(lambda ()
(setlocale LC_MESSAGES locale))
(lambda (key . args)
(error
(simple-format
#f
"error changing locale to ~A: ~A ~A"
locale key args))))
(let ((message
(lint-warning-message lint-warning)))
(setlocale LC_MESSAGES source-locale)
(if (string=? message source-message)
#f
(cons locale message))))
(list ,@locales))))
(cons (cons source-locale source-message)
messages-by-locale))))
(filter
(match-lambda
((package-id . warnings)
(not (null? warnings)))
(a
(error (simple-format #f "NO MATCH FOR ~A\n" a))))
(hash-map->list
(lambda (package-id package)
(cons
package-id
(catch
#t
(lambda ()
(map process-lint-warning
(if (and lint-checker-requires-store?-defined?
(lint-checker-requires-store? checker))
(check package #:store store)
(check package))))
(lambda (key . args)
'()))))
%package-table)))))
(inferior-eval '(use-modules (srfi srfi-1)
(guix lint)) inf)
(inferior-packages inf)
(let ((checkers
(inferior-eval
'(begin
(map (lambda (checker)
(list (lint-checker-name checker)
(lint-checker-description checker)
(if (memq checker %network-dependent-checkers)
#t
#f)))
%all-checkers))
inf)))
(map
(match-lambda
((name description network-dependent?)
(cons
(list name description network-dependent?)
(if network-dependent?
'()
(inferior-eval-with-store inf store (lint-warnings-for-checker
name))))))
checkers)))
(let* ((channel
(channel
(name 'guix)
(commit "d523eb5c9c2659cbbaf4eeef3691234ae527ee6a")
(url "https://git.savannah.gnu.org/git/guix.git";)))
(inferior
(inferior-for-channels (list channel)))
(result
(with-store store
(all-inferior-lint-warnings inferior store)
;; Running all-inferior-lint-warnings once doesn't seem to always
;; produce the crash, so just run it again
(all-inferior-lint-warnings inferior store))))
(peek "RESULT" result))
signature.asc
Description: PGP signature
