summaryrefslogtreecommitdiff
path: root/tests/challenge.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-12-07 15:10:39 +0100
committerLudovic Courtès <ludo@gnu.org>2019-12-12 17:56:58 +0100
commit5208db3a526e3fcdb8473d9bab8afe498c5f3f76 (patch)
tree7879ec7202bf6119509a270e973e456113261975 /tests/challenge.scm
parent22f06a212879369bd1d7f3aa5b19f8f89a8c6693 (diff)
challenge: Add "--diff".
* guix/scripts/challenge.scm (dump-port*): New variable. (archive-contents, store-item-contents, narinfo-contents) (differing-files, report-differing-files): New procedures. (summarize-report): Add #:report-differences and call it. (show-help, %options): Add "--diff". (%default-options): Add 'difference-report' key. (report-differing-files): Parameterize CURRENT-TERMINAL-COLUMNS and pass #:report-differences to 'summarize-report'. * guix/tests/http.scm (%local-url): Add optional argument. (call-with-http-server): Fix docstring typo. * tests/challenge.scm (query-path-size, make-narinfo): New procedures. ("differing-files"): New test. * doc/guix.texi (Invoking guix challenge): Document "--diff".
Diffstat (limited to 'tests/challenge.scm')
-rw-r--r--tests/challenge.scm67
1 files changed, 66 insertions, 1 deletions
diff --git a/tests/challenge.scm b/tests/challenge.scm
index c962800f3f..a2782abcbd 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,22 +18,32 @@
(define-module (test-challenge)
#:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module (gcrypt hash)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix derivations)
+ #:use-module (guix serialization)
+ #:use-module (guix packages)
#:use-module (guix gexp)
+ #:use-module (guix base32)
#:use-module (guix scripts challenge)
#:use-module (guix scripts substitute)
+ #:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
+ #:use-module (rnrs io ports)
#:use-module (ice-9 match))
(define query-path-hash*
(store-lift query-path-hash))
+(define (query-path-size item)
+ (mlet %store-monad ((info (query-path-info* item)))
+ (return (path-info-nar-size info))))
+
(define* (call-with-derivation-narinfo* drv thunk hash)
(lambda (store)
(with-derivation-narinfo drv (sha256 => hash)
@@ -138,7 +148,62 @@
(bytevector=? (narinfo-hash->sha256
(narinfo-hash narinfo))
hash))))))))))))
+(define (make-narinfo item size hash)
+ (format #f "StorePath: ~a
+Compression: none
+URL: nar/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
+NarSize: ~d
+NarHash: sha256:~a
+References: ~%" item size (bytevector->nix-base32-string hash)))
+(test-assertm "differing-files"
+ ;; Pretend we have two different results for the same store item, ITEM,
+ ;; with "/bin/guile" differing between the two nars, and make sure
+ ;; 'differing-files' returns it.
+ (mlet* %store-monad
+ ((drv1 (package->derivation %bootstrap-guile))
+ (drv2 (gexp->derivation
+ "broken-guile"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (copy-recursively #$drv1 #$output)
+ (chmod (string-append #$output "/bin/guile")
+ #o755)
+ (call-with-output-file (string-append
+ #$output
+ "/bin/guile")
+ (lambda (port)
+ (display "corrupt!" port)))))))
+ (out1 -> (derivation->output-path drv1))
+ (out2 -> (derivation->output-path drv2))
+ (item -> (string-append (%store-prefix) "/"
+ (make-string 32 #\a) "-foo")))
+ (mbegin %store-monad
+ (built-derivations (list drv1 drv2))
+ (mlet* %store-monad ((size1 (query-path-size out1))
+ (size2 (query-path-size out2))
+ (hash1 (query-path-hash* out1))
+ (hash2 (query-path-hash* out2))
+ (nar1 -> (call-with-bytevector-output-port
+ (lambda (port)
+ (write-file out1 port))))
+ (nar2 -> (call-with-bytevector-output-port
+ (lambda (port)
+ (write-file out2 port)))))
+ (parameterize ((%http-server-port 9000))
+ (with-http-server `((200 ,(make-narinfo item size1 hash1))
+ (200 ,nar1))
+ (parameterize ((%http-server-port 9001))
+ (with-http-server `((200 ,(make-narinfo item size2 hash2))
+ (200 ,nar2))
+ (mlet* %store-monad ((urls -> (list (%local-url 9000)
+ (%local-url 9001)))
+ (reports (compare-contents (list item)
+ urls)))
+ (pk 'report reports)
+ (return (equal? (differing-files (car reports))
+ '("/bin/guile"))))))))))))
(test-end)