%%%% Starting test monads
Group begin: monads
Test begin:
  test-name: "monad?"
  source-file: "tests/monads.scm"
  source-line: 51
  source-form: (test-assert "monad?" (and (every monad? %monads) (every (compose procedure? monad-bind) %monads) (every (compose procedure? monad-return) %monads)))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "left identity"
  source-file: "tests/monads.scm"
  source-line: 58
  source-form: (test-assert "left identity" (every (lambda (monad run) (let ((number (random 777))) (with-monad monad (define (f x) (return (* (#{1+}# number) 2))) (= (run (>>= (return number) f)) (run (f number)))))) %monads %monad-run))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "right identity"
  source-file: "tests/monads.scm"
  source-line: 70
  source-form: (test-assert "right identity" (every (lambda (monad run) (with-monad monad (let ((number (return (random 777)))) (= (run (>>= number return)) (run number))))) %monads %monad-run))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "associativity"
  source-file: "tests/monads.scm"
  source-line: 79
  source-form: (test-assert "associativity" (every (lambda (monad run) (with-monad monad (define (f x) (return (+ 1 x))) (define (g x) (return (* 2 x))) (let ((number (return (random 777)))) (= (run (>>= (>>= number f) g)) (run (>>= number (lambda (x) (>>= (f x) g)))))))) %monads %monad-run))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "lift"
  source-file: "tests/monads.scm"
  source-line: 93
  source-form: (test-assert "lift" (every (lambda (monad run) (let ((f (lift1 #{1+}# monad))) (with-monad monad (let ((number (random 777))) (= (run (>>= (return number) f)) (#{1+}# number)))))) %monads %monad-run))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "mlet* + text-file + package-file"
  source-file: "tests/monads.scm"
  source-line: 103
  source-form: (test-assert "mlet* + text-file + package-file" (run-with-store %store (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) (file (text-file "monadic" guile))) (return (equal? (call-with-input-file file get-string-all) guile))) #:guile-for-build (package-derivation %store %bootstrap-guile)))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "mlet* + derivation-expression"
  source-file: "tests/monads.scm"
  source-line: 114
  source-form: (test-assert "mlet* + derivation-expression" (run-with-store %store (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) (gdrv (package->derivation %bootstrap-guile)) (exp -> (quasiquote (let ((out (assoc-ref %outputs "out"))) (mkdir out) (symlink (unquote guile) (string-append out "/guile-rocks"))))) (drv (derivation-expression "rocks" exp #:inputs (quasiquote (("g" (unquote gdrv)))))) (out -> (derivation->output-path drv)) (built? (built-derivations (list drv)))) (return (and built? (equal? guile (readlink (string-append out "/guile-rocks")))))) #:guile-for-build (package-derivation %store %bootstrap-guile)))
Test end:
  result-kind: fail
  actual-value: #f
  actual-error: (srfi-34 #<condition &nix-protocol-error [message: "closing file descriptor 48: Bad file descriptor" status: 1] 9db7d98>)
Test begin:
  test-name: "text-file*"
  source-file: "tests/monads.scm"
  source-line: 132
  source-form: (test-assert "text-file*" (let ((references (store-lift references))) (run-with-store %store (mlet* %store-monad ((drv (package->derivation %bootstrap-guile)) (guile -> (derivation->output-path drv)) (file (text-file "bar" "This is bar.")) (text (text-file* "foo" %bootstrap-guile "/bin/guile " (quasiquote ((unquote %bootstrap-guile) "out")) "/bin/guile " drv "/bin/guile " file)) (done (built-derivations (list text))) (out -> (derivation->output-path text)) (refs (references out))) (return (and (lset= string=? refs (list guile file)) (equal? (call-with-input-file out get-string-all) (string-append guile "/bin/guile " guile "/bin/guile " guile "/bin/guile " file))))) #:guile-for-build (package-derivation %store %bootstrap-guile))))
Test end:
  result-kind: fail
  actual-value: #f
  actual-error: (srfi-34 #<condition &nix-protocol-error [message: "closing file descriptor 878772272: Bad file descriptor" status: 1] 9b57348>)
Test begin:
  test-name: "mapm"
  source-file: "tests/monads.scm"
  source-line: 156
  source-form: (test-assert "mapm" (every (lambda (monad run) (with-monad monad (equal? (run (mapm monad (lift1 #{1+}# monad) (map return (iota 10)))) (map #{1+}# (iota 10))))) %monads %monad-run))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "sequence"
  source-file: "tests/monads.scm"
  source-line: 164
  source-form: (test-assert "sequence" (every (lambda (monad run) (let* ((input (iota 100)) (order (quote ()))) (define (frob i) (set! order (cons i order)) i) (and (equal? input (run (sequence monad (map (lift1 frob monad) input)))) (equal? order (reverse input))))) %monads %monad-run))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "listm"
  source-file: "tests/monads.scm"
  source-line: 183
  source-form: (test-assert "listm" (every (lambda (monad run) (run (with-monad monad (let ((lst (listm monad (return 1) (return 2) (return 3)))) (mlet monad ((lst lst)) (return (equal? (quote (1 2 3)) lst))))))) %monads %monad-run))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "anym"
  source-file: "tests/monads.scm"
  source-line: 193
  source-form: (test-assert "anym" (every (lambda (monad run) (eq? (run (with-monad monad (let ((lst (list (return 1) (return 2) (return 3)))) (anym monad (lambda (x) (and (odd? x) (quote odd!))) lst)))) (quote odd!))) %monads %monad-run))
Test end:
  result-kind: pass
  actual-value: #t
Group end: monads
# of expected passes      10
# of unexpected failures  2