bug#51391: Guile-SSH 0.13.1 test suite fails non-deterministically

[Maxim Cournoyer]

Hello Guix!

I encountered the following Guile-SSH test failure while testing the
core-updates-frozen-batched-changes branch:

--8<---------------cut here---------------start------------->8---
Test suite failed, dumping logs.

--- ./tests/test-suite.log --------------------------------------------------

============================================
   Guile-SSH 0.13.1: tests/test-suite.log
============================================

# TOTAL: 11
# PASS:  10
# SKIP:  0
# XFAIL: 0
# FAIL:  1
# XPASS: 0
# ERROR: 0

.. contents:: :depth: 2

FAIL: session
=============

%%%% Starting test session
Group begin: session
Test begin:
  test-name: "%make-session"
  source-file: "tests/session.scm"
  source-line: 38
  source-form: (test-assert "%make-session" (%make-session))
Test end:
  result-kind: pass
  actual-value: #<session #<undefined>@#<undefined>:22 (disconnected) 
7fffefd6dfe0>
Test begin:
  test-name: "%make-session, gc test"
  source-file: "tests/session.scm"
  source-line: 41
  source-form: (test-assert "%make-session, gc test" (begin (set-log-userdata! 
"%make-session, gc test") (let ((max-sessions 1000)) (do ((idx 1 (+ idx 1))) 
((> idx max-sessions)) (when (zero? (euclidean-remainder idx 100)) 
(format-log/scm (quote nolog) "" (format #f "~d / ~d sessions created ..." idx 
max-sessions))) (%make-session)) #t)))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "session?"
  source-file: "tests/session.scm"
  source-line: 51
  source-form: (test-assert "session?" (let ((session (%make-session)) (x 
"string")) (and (session? session) (not (session? x)))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "comparison of sessions"
  source-file: "tests/session.scm"
  source-line: 57
  source-form: (test-assert "comparison of sessions" (let ((s1 (%make-session)) 
(s2 (%make-session))) (and (equal? s1 s1) (not (equal? s1 s2)))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "session-set!, valid values"
  source-file: "tests/session.scm"
  source-line: 63
  source-form: (test-assert "session-set!, valid values" (let ((session 
(%make-session)) (options (quasiquote ((host "localhost") (port 22) (bindaddr 
"127.0.0.1") (user "Random J. User") (timeout 15) (timeout-usec 15000) (ssh1 #f 
#t) (ssh2 #f #t) (log-verbosity nolog rare protocol packet functions nolog) 
(compression-level 1 2 3 4 5 6 7 8 9) (compression "yes" "no") (callbacks 
((user-data . "hello") (global-request-callback unquote (const #f))))))) (res 
#t)) (if (>= %libssh-minor-version 8) (set! options (cons (quote (nodelay #f 
#t)) options))) (for-each (lambda (opt) (for-each (lambda (val) (session-set! 
session (car opt) val)) (cdr opt))) options) res))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "session-set!, invalid values"
  source-file: "tests/session.scm"
  source-line: 93
  source-form: (test-assert "session-set!, invalid values" (let ((session 
(%make-session)) (options (quote ((host 12345 #t) (port "string" -22) (bindaddr 
12345 -12345) (user 12345 -12345) (timeout "string" -15) (timeout-usec "string" 
-15000) (ssh1 12345 "string") (ssh2 12345 "string") (log-verbosity "string" -1 
0 1 2 3 4 5) (compression 12345) (compression-level -1 0 10) (callbacks "not a 
list" ((global-request-callback . #f)))))) (res #t)) (if (>= 
%libssh-minor-version 8) (set! options (cons (quote (nodelay 12345 "string")) 
options))) (for-each (lambda (opt) (for-each (lambda (val) (catch #t (lambda () 
(session-set! session (car opt) val) (let* ((r (test-runner-current)) (l 
(test-runner-aux-value r))) (format l "  opt: ~a, val: ~a -- passed 
mistakenly~%" (car opt) val) (set! res #f))) (const #t))) (cdr opt))) options) 
res))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "session-set!, invalid option type"
  source-file: "tests/session.scm"
  source-line: 130
  source-form: (test-error "session-set!, invalid option type" (quote 
wrong-type-arg) (let ((session (%make-session))) (session-set! session 
"non-valid type" "value")))
Test end:
  result-kind: pass
  actual-error: (wrong-type-arg "session-set!" "Wrong type argument in position 
~A: ~S" (2 "non-valid type") ("non-valid type"))
  expected-error: wrong-type-arg
Test begin:
  test-name: "session-get"
  source-file: "tests/session.scm"
  source-line: 135
  source-form: (test-assert "session-get" (let* ((host "example.com") (port 
12345) (user "alice") (proxycommand "test") (callbacks (quote ((user-data . 
"test")))) (session (make-session #:host host #:port port #:user user 
#:identity %rsakey #:proxycommand proxycommand #:callbacks callbacks))) (and 
(string=? (session-get session (FAIL session.scm (exit status: 139)


error: in phase 'check': uncaught exception:
%exception #<&invoke-error program: "make" arguments: ("check" "-j" "24") 
exit-status: 2 term-signal: #f stop-signal: #f> 
phase `check' failed after 4.8 seconds
command "make" "check" "-j" "24" failed with status 2
builder for `/gnu/store/4winz6sffwfw5xkvkig1n8chzfxg51an-guile-ssh-0.13.1.drv' 
failed with exit code 1
@ build-failed /gnu/store/4winz6sffwfw5xkvkig1n8chzfxg51an-guile-ssh-0.13.1.drv 
- 1 builder for 
`/gnu/store/4winz6sffwfw5xkvkig1n8chzfxg51an-guile-ssh-0.13.1.drv' failed with 
exit code 1
--8<---------------cut here---------------end--------------->8---

It seems easy to trigger it by building tens of times in a row (say,
with --rounds=100).

Here's anothe, different failure:

--8<---------------cut here---------------start------------->8---
Test suite failed, dumping logs.

--- ./tests/test-suite.log --------------------------------------------------

============================================
   Guile-SSH 0.13.1: tests/test-suite.log
============================================

# TOTAL: 11
# PASS:  10
# SKIP:  0
# XFAIL: 0
# FAIL:  1
# XPASS: 0
# ERROR: 0

.. contents:: :depth: 2

FAIL: dist
==========

%%%% Starting test dist
Group begin: dist
Test begin:
  test-name: "make-node"
  source-file: "tests/dist.scm"
  source-line: 44
  source-form: (test-assert "make-node" (begin (set-log-userdata! "make-node") 
(run-client-test (lambda (server) (start-server/exec server (const #t))) 
(lambda () (call-with-connected-session/shell (lambda (session) (let ((n 
(make-node session))) (and n (eq? (node-session n) session)))))))))
Test end:
  result-kind: fail
  actual-value: #f
  actual-error: (quit 1)
Test begin:
  test-name: "split, 1"
  source-file: "tests/dist.scm"
  source-line: 57
  source-form: (test-equal "split, 1" (quote ((a b) (c d) (e f g))) (split 
(quote (a b c d%%%% Starting test dist  (Writing full log to "dist.log")
tests/dist.scm:44: FAIL make-node
# of expected passes      18
# of unexpected failures  1
lit, 2"
  source-file: "tests/dist.scm"
  source-line: 61
  source-form: (test-equal "split, 2" (quote ((a))) (split (quote (a)) 2))
Test end:
  result-kind: pass
  actual-value: ((a))
  expected-value: ((a))
Test begin:
  test-name: "make-job"
  source-file: "tests/dist.scm"
  source-line: 66
  source-form: (test-assert "make-job" (begin (set-log-userdata! "make-job") 
(run-client-test (lambda (server) (start-server/exec server (const #f))) 
(lambda () (call-with-connected-session/shell (lambda (session) (let* ((node 
(make-node session)) (data (quote (1 2 3))) (proc (quote (lambda (n) (#{1+}# 
n)))) (j (make-job (quote map) node data proc))) (and (eq? (job-type j) (quote 
map)) (eq? (job-node j) node) (eq? (job-data j) data) (eq? (job-proc j) 
proc)))))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "set-job-node"
  source-file: "tests/dist.scm"
  source-line: 85
  source-form: (test-assert "set-job-node" (begin (set-log-userdata! 
"set-job-node") (run-client-test (lambda (server) (start-server/exec server 
(const #t))) (lambda () (call-with-connected-session/shell (lambda (session) 
(let* ((n1 (make-node session)) (n2 (make-node session)) (data (quote ())) 
(proc (quote (lambda (n) (#{1+}# n)))) (j1 (make-job (quote map) n1 data proc)) 
(j2 (set-job-node j1 n2))) (and (not (eq? j1 j2)) (eq? (job-type j1) (job-type 
j2)) (eq? (job-node j1) n1) (eq? (job-node j2) n2) (eq? (job-data j1) (job-data 
j2)) (eq? (job-proc j1) (job-proc j2))))))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "hand-out-job, invalid type"
  source-file: "tests/dist.scm"
  source-line: 107
  source-form: (test-assert "hand-out-job, invalid type" (begin 
(set-log-userdata! "hand-out-job, invalid type") (catch #t (lambda () 
(run-client-test (lambda (server) (start-server/exec server (const #t))) 
(lambda () (call-with-connected-session/shell (lambda (session) (let ((n 
(make-node session))) (hand-out-job (make-job (quote invalid-job) n (quote ()) 
(const #t)))))))) #f) (const #t))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "assign-eval"
  source-file: "tests/dist.scm"
  source-line: 120
  source-form: (test-assert "assign-eval" (begin (set-log-userdata! 
"assign-eval") (run-client-test (lambda (server) (start-server/exec server 
(const #t))) (lambda () (call-with-connected-session/shell (lambda (session) 
(let* ((nodes (make-list 2 (make-node session))) (exprs (make-list 10 (quote 
(lambda (x) (#{1+}# x))))) (jobs (assign-eval nodes exprs))) (and (eq? (length 
jobs) 2) (eq? (job-type (car jobs)) (quote eval)) (eq? (length (job-proc (car 
jobs))) 5)))))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-get-result"
  source-file: "tests/dist.scm"
  source-line: 141
  source-form: (test-assert "rrepl-get-result" (receive (result eval-num 
module-name lang) (call-with-input-string "scheme@(guile-user)> $0 = test" 
rrepl-get-result) (and (eq? result (quote test)) (= eval-num 0) (string=? 
module-name "(guile-user)") (string=? lang "scheme"))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-get-result, unspecified"
  source-file: "tests/dist.scm"
  source-line: 150
  source-form: (test-assert "rrepl-get-result, unspecified" (receive (result 
eval-num module-name lang) (call-with-input-string "scheme@(guile-user)> " 
rrepl-get-result) (and (eq? result *unspecified*) (eq? eval-num *unspecified*) 
(string=? module-name "(guile-user)") (string=? lang "scheme"))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-get-result, error"
  source-file: "tests/dist.scm"
  source-line: 159
  source-form: (test-assert "rrepl-get-result, error" (begin (set-log-userdata! 
"rrepl-get-result, error") (catch #t (lambda () (call-with-input-string 
"scheme@(guile-user)> ERROR: error." rrepl-get-result) #f) (lambda (key . args) 
(if (equal? key (quote node-repl-error)) (let* ((message (cadr args)) (result 
(string=? message "scheme@(guile-user)> ERROR: error."))) (unless result 
(format-log/scm (quote nolog) "rrepl-get-result, error" (string-append 
"Messages do not match: " "expected \"~a\", got \"~a\"") result 
"scheme@(guile-user)> ERROR: error.")) result) (begin (format-log/scm (quote 
nolog) "rrepl-get-result, error" (string-append "Errors do not match: " 
"expected '~a', got '~a' (args: ~a)") (quote node-repl-error) key args) #f))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-get-result, compilation error"
  source-file: "tests/dist.scm"
  source-line: 165
  source-form: (test-assert "rrepl-get-result, compilation error" (begin 
(set-log-userdata! "rrepl-get-result, compilation error") (catch #t (lambda () 
(call-with-input-string (string-append "scheme@(guile-user)> While compiling 
expression:\n" "ERROR: no code for module (module-that-doesnt-exist)") 
rrepl-get-result) #f) (lambda (key . args) (if (equal? key (quote 
node-repl-error)) (let* ((message (cadr args)) (result (string=? message 
"scheme@(guile-user)> While compiling expression:\nERROR: no code for module 
(module-that-doesnt-exist)"))) (unless result (format-log/scm (quote nolog) 
"rrepl-get-result, compilation error" (string-append "Messages do not match: " 
"expected \"~a\", got \"~a\"") result "scheme@(guile-user)> While compiling 
expression:\nERROR: no code for module (module-that-doesnt-exist)")) result) 
(begin (format-log/scm (quote nolog) "rrepl-get-result, compilation error" 
(string-append "Errors do not match: " "expected '~a', got '~a' (args: ~a)") 
(quote node-repl-error) key args) #f))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-get-result, unbound variable error"
  source-file: "tests/dist.scm"
  source-line: 172
  source-form: (test-assert "rrepl-get-result, unbound variable error" (begin 
(set-log-userdata! "rrepl-get-result, unbound variable error") (catch #t 
(lambda () (call-with-input-string (string-append (string-append 
"scheme@(guile-user)> ;;; socket:9:7: warning: " "possibly unbound variable 
`e'\nsocket:9:7: " "In procedure #<procedure 1a44920 at socket:9:7 ()>:\n" 
"socket:9:7: In procedure module-lookup: Unbound variable: e")) 
rrepl-get-result) #f) (lambda (key . args) (if (equal? key (quote 
node-repl-error)) (let* ((message (cadr args)) (result (string=? message 
"scheme@(guile-user)> ;;; socket:9:7: warning: possibly unbound variable 
`e'\nsocket:9:7: In procedure #<procedure 1a44920 at socket:9:7 
()>:\nsocket:9:7: In procedure module-lookup: Unbound variable: e"))) (unless 
result (format-log/scm (quote nolog) "rrepl-get-result, unbound variable error" 
(string-append "Messages do not match: " "expected \"~a\", got \"~a\"") result 
"scheme@(guile-user)> ;;; socket:9:7: warning: possibly unbound variable 
`e'\nsocket:9:7: In procedure #<procedure 1a44920 at socket:9:7 
()>:\nsocket:9:7: In procedure module-lookup: Unbound variable: e")) result) 
(begin (format-log/scm (quote nolog) "rrepl-get-result, unbound variable error" 
(string-append "Errors do not match: " "expected '~a', got '~a' (args: ~a)") 
(quote node-repl-error) key args) #f))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-get-result, unknown # object error"
  source-file: "tests/dist.scm"
  source-line: 185
  source-form: (test-assert "rrepl-get-result, unknown # object error" (begin 
(set-log-userdata! "rrepl-get-result, unknown # object error") (catch #t 
(lambda () (call-with-input-string (string-append "scheme@(guile-user)> $4 = " 
"#<session #<undefined>@#<undefined>:22 (disconnected) 453fff>") 
rrepl-get-result) #f) (lambda (key . args) (if (equal? key (quote 
node-repl-error)) (let* ((message (cadr args)) (result (string=? message 
"Reader error: #f: #<unknown port>:1:3: Unknown # object: (\"#<\"): 
scheme@(guile-user)> $4 = #<session #<undefined>@#<undefined>:22 (disconnected) 
453fff>"))) (unless result (format-log/scm (quote nolog) "rrepl-get-result, 
unknown # object error" (string-append "Messages do not match: " "expected 
\"~a\", got \"~a\"") result "Reader error: #f: #<unknown port>:1:3: Unknown # 
object: (\"#<\"): scheme@(guile-user)> $4 = #<session 
#<undefined>@#<undefined>:22 (disconnected) 453fff>")) result) (begin 
(format-log/scm (quote nolog) "rrepl-get-result, unknown # object error" 
(string-append "Errors do not match: " "expected '~a', got '~a' (args: ~a)") 
(quote node-repl-error) key args) #f))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-get-result, elisp"
  source-file: "tests/dist.scm"
  source-line: 194
  source-form: (test-assert "rrepl-get-result, elisp" (receive (result eval-num 
module-name lang) (call-with-input-string "elisp@(guile-user)> $0 = #nil" 
rrepl-get-result) (and (eq? result (quote #nil)) (= eval-num 0) (string=? 
module-name "(guile-user)") (string=? lang "elisp"))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-get-result, multiple values"
  source-file: "tests/dist.scm"
  source-line: 203
  source-form: (test-assert "rrepl-get-result, multiple values" (receive 
(result eval-num module-name lang) (call-with-input-string 
"scheme@(guile-user)> $0 = v1\n$1 = v2" rrepl-get-result) (and (vector? 
eval-num) (vector? result) (eq? (vector-ref result 0) (quote v1)) (eq? 
(vector-ref result 1) (quote v2)) (= (vector-ref eval-num 0) 0) (= (vector-ref 
eval-num 1) 1) (string=? module-name "(guile-user)") (string=? lang "scheme"))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-skip-to-prompt, valid input"
  source-file: "tests/dist.scm"
  source-line: 217
  source-form: (test-assert "rrepl-skip-to-prompt, valid input" (begin 
(call-with-input-string "Enter `,help' for help." (lambda (port) 
(rrepl-skip-to-prompt port))) #t))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "rrepl-skip-to-prompt, invalid input"
  source-file: "tests/dist.scm"
  source-line: 224
  source-form: (test-assert "rrepl-skip-to-prompt, invalid input" (begin 
(set-log-userdata! "rrepl-skip-to-prompt, invalid input") (catch #t (lambda () 
(call-with-input-string "invalid input" (lambda (port) (rrepl-skip-to-prompt 
port))) #f) (lambda (key . args) (let ((result (equal? key (quote 
node-error)))) (unless result (format-log/scm (quote nolog) 
"rrepl-skip-to-prompt, invalid input" (string-append "Errors do not match: " 
"expected ~a, got ~a (args: ~a)") (quote node-error) key args)) result)))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "node-guile-version, valid response"
  source-file: "tests/dist.scm"
  source-line: 229
  source-form: (test-assert "node-guile-version, valid response" (begin 
(set-log-userdata! "node-guile-version, valid response") (run-client-test 
(lambda (server) (start-server/exec server (const #t))) (lambda () 
(call-with-connected-session/shell (lambda (session) (format-log/scm (quote 
nolog) "client" "session: ~a" session) (let ((n (make-node session))) (string=? 
(node-guile-version n) "GNU Guile 2.2.3"))))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "with-ssh"
  source-file: "tests/dist.scm"
  source-line: 249
  source-form: (test-assert "with-ssh" (begin (set-log-userdata! "with-ssh") 
(run-client-test (lambda (server) (start-server/exec server (lambda (session 
message channel) (let ((line (read-line channel))) (format-log/scm (quote 
nolog) "with-ssh" "client request: ~A" line) (write-line "$1 = 42\n" 
channel))))) (lambda () (call-with-connected-session/shell (lambda (session) 
(format-log/scm (quote nolog) "client" "session: ~a" session) (let ((n 
(make-node session))) (= (with-ssh n (+ 21 21)) 42))))))))
Test end:
  result-kind: pass
  actual-value: #t
Group end: dist
# of expected passes      18
# of unexpected failures  1
FAIL dist.scm (exit status: 1)


error: in phase 'check': uncaught exception:
%exception #<&invoke-error program: "make" arguments: ("check" "-j" "24") 
exit-status: 2 term-signal: #f stop-signal: #f> 
phase `check' failed after 4.8 seconds
command "make" "check" "-j" "24" failed with status 2
builder for `/gnu/store/4winz6sffwfw5xkvkig1n8chzfxg51an-guile-ssh-0.13.1.drv' 
failed with exit code 1
--8<---------------cut here---------------end--------------->8---

Thanks,

Maxim