kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

status: Change tests from SRFI-11 to SRFI-71.

Browse Source 
* tests/status.scm: Use SRFI-71 'let' instead of SRFI-11 'let-values'.
This commit is contained in:
Ludovic Courtès 2022-06-26 16:00:17 +02:00
parent d9d77d9479
commit c31605b582
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 34 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
tests/status.scm
View File

@ -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 @@
(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,11 +52,11 @@
#: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
(const 'now)))))) (const 'now))))))
(display "@ build-started foo.drv - x86_64-linux \n" port) (display "@ build-started foo.drv - x86_64-linux \n" port)
(display "@ substituter-started bar\n" port) (display "@ substituter-started bar\n" port)
(display "@ download-started bar http://example.org/bar 500\n" port) (display "@ download-started bar http://example.org/bar 500\n" port)
@ -100,11 +99,11 @@
#: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
(const 'now)))))) (const 'now))))))
(display "@ build-started foo.drv - x86_64-linux foo.log\n" port) (display "@ build-started foo.drv - x86_64-linux foo.log\n" port)
(display "@ download-started bar http://example.org/bar 999\n" port) (display "@ download-started bar http://example.org/bar 999\n" port)
(display "various\nthings\nget\nwritten\n" port) (display "various\nthings\nget\nwritten\n" port)
@ -119,8 +118,8 @@
(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 @@
;; 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,14 +155,14 @@
#: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
(const 'now) (const 'now)
#:derivation-path->output-path #:derivation-path->output-path
(match-lambda (match-lambda
("bar.drv" "bar"))))))) ("bar.drv" "bar")))))))
(display "@ build-started foo.drv - x86_64-linux 121\n" port) (display "@ build-started foo.drv - x86_64-linux 121\n" port)
(display "@ build-started bar.drv - armhf-linux bar.log 144\n" port) (display "@ build-started bar.drv - armhf-linux bar.log 144\n" port)
(display "@ build-log 121 6\nHello!" port) (display "@ build-log 121 6\nHello!" port)
@ -192,11 +191,11 @@
(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
(const 'now)))))) (const 'now))))))
(display "@ build-started foo.drv - x86_64-linux 121\n" port) (display "@ build-started foo.drv - x86_64-linux 121\n" port)
(display "@ build-log 121 6\nHello!" port) (display "@ build-log 121 6\nHello!" port)
(let ((first (get-status))) (let ((first (get-status)))
@ -225,11 +224,11 @@
(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
(const 'now)))))) (const 'now))))))
(display "@ build-started foo.drv - x86_64-linux 121\n" port) (display "@ build-started foo.drv - x86_64-linux 121\n" port)
(display "@ build-log 121 27\nstarting phase `configure'\n" port) (display "@ build-log 121 27\nstarting phase `configure'\n" port)
(display "@ build-log 121 6\nabcde!" port) (display "@ build-log 121 6\nabcde!" port)