me
/
guix
Archived
1
0
Fork 0
Code

tests: Import (guix build syscalls) when (guix build store-copy) is used. 

Fixes a test failure introduced in
189525412e.

* guix/progress.scm: Autoload (guix build syscalls).
* tests/gexp.scm ("gexp->derivation, store copy"): Add (guix build
syscalls) to the list of imported modules.  Use ‘with-imported-modules’
rather than #:modules.

Change-Id: I8d3fe90f564ef4b1a340f34cee6c08a741f7b836
master
Ludovic Courtès 2023-11-23 15:22:42 +01:00
parent e04f8fe4ea
commit 9b48cf8cdd
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 28 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
guix/progress.scm
View File

@ -21,8 +21,7 @@
(define-module (guix progress) (define-module (guix progress)
#:use-module (guix records) #:use-module (guix records)
#:use-module ((guix build syscalls) #:autoload (guix build syscalls) (terminal-string-width)
#:select (terminal-string-width))
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)

53
tests/gexp.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -826,38 +826,39 @@
(call-with-output-file (string-append #$output "/two") (call-with-output-file (string-append #$output "/two")
(lambda (port) (lambda (port)
(display "This is the second one." port)))))) (display "This is the second one." port))))))
(build-drv #~(begin (build-drv
(use-modules (guix build store-copy) (with-imported-modules '((guix build store-copy)
(guix build utils) (guix build syscalls)
(srfi srfi-1)) (guix progress)
(guix records)
(guix sets)
(guix build utils))
#~(begin
(use-modules (guix build store-copy)
(guix build utils)
(srfi srfi-1))
(define (canonical-file? file) (define (canonical-file? file)
;; Copied from (guix tests). ;; Copied from (guix tests).
(let ((st (lstat file))) (let ((st (lstat file)))
(or (not (string-prefix? (%store-directory) file)) (or (not (string-prefix? (%store-directory) file))
(eq? 'symlink (stat:type st)) (eq? 'symlink (stat:type st))
(and (= 1 (stat:mtime st)) (and (= 1 (stat:mtime st))
(zero? (logand #o222 (stat:mode st))))))) (zero? (logand #o222 (stat:mode st)))))))
(mkdir #$output) (mkdir #$output)
(populate-store '("graph") #$output (populate-store '("graph") #$output
#:deduplicate? #f) #:deduplicate? #f)
;; Check whether 'populate-store' canonicalizes ;; Check whether 'populate-store' canonicalizes
;; permissions and timestamps. ;; permissions and timestamps.
(unless (every canonical-file? (find-files #$output)) (unless (every canonical-file? (find-files #$output))
(error "not canonical!" #$output))))) (error "not canonical!" #$output))))))
(mlet* %store-monad ((one (gexp->derivation "one" build-one)) (mlet* %store-monad ((one (gexp->derivation "one" build-one))
(two (gexp->derivation "two" (build-two one))) (two (gexp->derivation "two" (build-two one)))
(drv (gexp->derivation "store-copy" build-drv (drv (gexp->derivation "store-copy" build-drv
#:references-graphs #:references-graphs
`(("graph" ,two)) `(("graph" ,two))))
#:modules
'((guix build store-copy)
(guix progress)
(guix records)
(guix sets)
(guix build utils))))
(ok? (built-derivations (list drv))) (ok? (built-derivations (list drv)))
(out -> (derivation->output-path drv))) (out -> (derivation->output-path drv)))
(let ((one (derivation->output-path one)) (let ((one (derivation->output-path one))