mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
status: Change tests from SRFI-11 to SRFI-71.
* tests/status.scm: Use SRFI-71 'let' instead of SRFI-11 'let-values'.
This commit is contained in:
parent
d9d77d9479
commit
c31605b582
1 changed files with 34 additions and 35 deletions
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2018, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -19,8 +19,8 @@
|
||||||
(define-module (test-status)
|
(define-module (test-status)
|
||||||
#:use-module (guix status)
|
#:use-module (guix status)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
|
#:use-module (srfi srfi-71)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match))
|
||||||
|
@ -29,8 +29,7 @@ (define-module (test-status)
|
||||||
|
|
||||||
(test-equal "compute-status, no-op"
|
(test-equal "compute-status, no-op"
|
||||||
(build-status)
|
(build-status)
|
||||||
(let-values (((port get-status)
|
(let ((port get-status (build-event-output-port compute-status)))
|
||||||
(build-event-output-port compute-status)))
|
|
||||||
(display "foo\nbar\n\baz\n" port)
|
(display "foo\nbar\n\baz\n" port)
|
||||||
(get-status)))
|
(get-status)))
|
||||||
|
|
||||||
|
@ -53,7 +52,7 @@ (define-module (test-status)
|
||||||
#:transferred 500
|
#:transferred 500
|
||||||
#:start 'now
|
#:start 'now
|
||||||
#:end 'now)))))
|
#:end 'now)))))
|
||||||
(let-values (((port get-status)
|
(let ((port get-status
|
||||||
(build-event-output-port (lambda (event status)
|
(build-event-output-port (lambda (event status)
|
||||||
(compute-status event status
|
(compute-status event status
|
||||||
#:current-time
|
#:current-time
|
||||||
|
@ -100,7 +99,7 @@ (define-module (test-status)
|
||||||
#:start 'now
|
#:start 'now
|
||||||
#:end 'now)))))
|
#:end 'now)))))
|
||||||
;; Below we omit 'substituter-started' events and the like.
|
;; Below we omit 'substituter-started' events and the like.
|
||||||
(let-values (((port get-status)
|
(let ((port get-status
|
||||||
(build-event-output-port (lambda (event status)
|
(build-event-output-port (lambda (event status)
|
||||||
(compute-status event status
|
(compute-status event status
|
||||||
#:current-time
|
#:current-time
|
||||||
|
@ -119,8 +118,8 @@ (define-module (test-status)
|
||||||
|
|
||||||
(test-equal "build-output-port, UTF-8"
|
(test-equal "build-output-port, UTF-8"
|
||||||
'((build-log #f "lambda is λ!\n"))
|
'((build-log #f "lambda is λ!\n"))
|
||||||
(let-values (((port get-status) (build-event-output-port cons '()))
|
(let ((port get-status (build-event-output-port cons '()))
|
||||||
((bv) (string->utf8 "lambda is λ!\n")))
|
(bv (string->utf8 "lambda is λ!\n")))
|
||||||
(put-bytevector port bv)
|
(put-bytevector port bv)
|
||||||
(force-output port)
|
(force-output port)
|
||||||
(get-status)))
|
(get-status)))
|
||||||
|
@ -129,7 +128,7 @@ (define-module (test-status)
|
||||||
;; What about a mixture of UTF-8 + garbage?
|
;; What about a mixture of UTF-8 + garbage?
|
||||||
(let ((replacement "<22>"))
|
(let ((replacement "<22>"))
|
||||||
`((build-log #f ,(string-append "garbage: " replacement "lambda: λ\n"))))
|
`((build-log #f ,(string-append "garbage: " replacement "lambda: λ\n"))))
|
||||||
(let-values (((port get-status) (build-event-output-port cons '())))
|
(let ((port get-status (build-event-output-port cons '())))
|
||||||
(display "garbage: " port)
|
(display "garbage: " port)
|
||||||
(put-bytevector port #vu8(128))
|
(put-bytevector port #vu8(128))
|
||||||
(put-bytevector port (string->utf8 "lambda: λ\n"))
|
(put-bytevector port (string->utf8 "lambda: λ\n"))
|
||||||
|
@ -156,7 +155,7 @@ (define-module (test-status)
|
||||||
#:transferred 999
|
#:transferred 999
|
||||||
#:start 'now
|
#:start 'now
|
||||||
#:end 'now)))))
|
#:end 'now)))))
|
||||||
(let-values (((port get-status)
|
(let ((port get-status
|
||||||
(build-event-output-port (lambda (event status)
|
(build-event-output-port (lambda (event status)
|
||||||
(compute-status event status
|
(compute-status event status
|
||||||
#:current-time
|
#:current-time
|
||||||
|
@ -192,7 +191,7 @@ (define-module (test-status)
|
||||||
(build-status
|
(build-status
|
||||||
(builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
|
(builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
|
||||||
#:completion 100.)))))
|
#:completion 100.)))))
|
||||||
(let-values (((port get-status)
|
(let ((port get-status
|
||||||
(build-event-output-port (lambda (event status)
|
(build-event-output-port (lambda (event status)
|
||||||
(compute-status event status
|
(compute-status event status
|
||||||
#:current-time
|
#:current-time
|
||||||
|
@ -225,7 +224,7 @@ (define-module (test-status)
|
||||||
(build-status
|
(build-status
|
||||||
(builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
|
(builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
|
||||||
#:phase 'install)))))
|
#:phase 'install)))))
|
||||||
(let-values (((port get-status)
|
(let ((port get-status
|
||||||
(build-event-output-port (lambda (event status)
|
(build-event-output-port (lambda (event status)
|
||||||
(compute-status event status
|
(compute-status event status
|
||||||
#:current-time
|
#:current-time
|
||||||
|
|
Loading…
Reference in a new issue