aboutsummaryrefslogtreecommitdiff
path: root/tests/challenge.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-01-13 23:30:43 +0100
committerLudovic Courtès <ludo@gnu.org>2017-01-14 00:57:51 +0100
commit4d8e95097e5c40da9dd57d358bd189dcf82ff9bf (patch)
tree7b7961bd62ee8e64e0c7d35a7e5bb715266ab294 /tests/challenge.scm
parent7988af99197c3d2f537608a46cab740a32d54e10 (diff)
downloadgnu-guix-4d8e95097e5c40da9dd57d358bd189dcf82ff9bf.tar
gnu-guix-4d8e95097e5c40da9dd57d358bd189dcf82ff9bf.tar.gz
challenge: Return comparison reports instead of just discrepancies.
This makes it easier to distinguish between matches, mismatches, and the various cases of inconclusive reports. * guix/scripts/challenge.scm (<discrepancy>): Rename to... (<comparison-report>): ... this. Add 'result' field. (comparison-report): New macro. (comparison-report-predicate, comparison-report-mismatch?) (comparison-report-match?) (comparison-report-inconclusive?): New procedures. (discrepancies): Rename to... (compare-contents): ... this. Change to return a list of <comparison-report>. Remove calls to 'warning'. (summarize-discrepancy): Rename to... (summarize-report): ... this. Adjust to <comparison-report>. (guix-challenge): Likewise. * tests/challenge.scm ("no discrepancies") ("one discrepancy"): Adjust to new API. ("inconclusive: no substitutes") ("inconclusive: no local build"): New tests.
Diffstat (limited to 'tests/challenge.scm')
-rw-r--r--tests/challenge.scm62
1 files changed, 53 insertions, 9 deletions
diff --git a/tests/challenge.scm b/tests/challenge.scm
index 9505042a45..387d205a64 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -69,8 +69,15 @@
(built-derivations (list drv))
(mlet %store-monad ((hash (query-path-hash* out)))
(with-derivation-narinfo* drv (sha256 => hash)
- (>>= (discrepancies (list out) (%test-substitute-urls))
- (lift1 null? %store-monad))))))))
+ (>>= (compare-contents (list out) (%test-substitute-urls))
+ (match-lambda
+ ((report)
+ (return
+ (and (string=? out (comparison-report-item report))
+ (bytevector=?
+ (comparison-report-local-sha256 report)
+ hash)
+ (comparison-report-match? report))))))))))))
(test-assertm "one discrepancy"
(let ((text (random-text)))
@@ -90,20 +97,57 @@
(modulo (+ b 1) 128))
w)))
(with-derivation-narinfo* drv (sha256 => wrong-hash)
- (>>= (discrepancies (list out) (%test-substitute-urls))
+ (>>= (compare-contents (list out) (%test-substitute-urls))
(match-lambda
- ((discrepancy)
+ ((report)
(return
- (and (string=? out (discrepancy-item discrepancy))
+ (and (string=? out (comparison-report-item (pk report)))
+ (eq? 'mismatch (comparison-report-result report))
(bytevector=? hash
- (discrepancy-local-sha256
- discrepancy))
- (match (discrepancy-narinfos discrepancy)
+ (comparison-report-local-sha256
+ report))
+ (match (comparison-report-narinfos report)
((bad)
(bytevector=? wrong-hash
(narinfo-hash->sha256
(narinfo-hash bad))))))))))))))))
+(test-assertm "inconclusive: no substitutes"
+ (mlet* %store-monad ((drv (gexp->derivation "foo" #~(mkdir #$output)))
+ (out -> (derivation->output-path drv))
+ (_ (built-derivations (list drv)))
+ (hash (query-path-hash* out)))
+ (>>= (compare-contents (list out) (%test-substitute-urls))
+ (match-lambda
+ ((report)
+ (return
+ (and (string=? out (comparison-report-item report))
+ (comparison-report-inconclusive? report)
+ (null? (comparison-report-narinfos report))
+ (bytevector=? (comparison-report-local-sha256 report)
+ hash))))))))
+
+(test-assertm "inconclusive: no local build"
+ (let ((text (random-text)))
+ (mlet* %store-monad ((drv (gexp->derivation "something"
+ #~(list #$output #$text)))
+ (out -> (derivation->output-path drv))
+ (hash -> (sha256 #vu8())))
+ (with-derivation-narinfo* drv (sha256 => hash)
+ (>>= (compare-contents (list out) (%test-substitute-urls))
+ (match-lambda
+ ((report)
+ (return
+ (and (string=? out (comparison-report-item report))
+ (comparison-report-inconclusive? report)
+ (not (comparison-report-local-sha256 report))
+ (match (comparison-report-narinfos report)
+ ((narinfo)
+ (bytevector=? (narinfo-hash->sha256
+ (narinfo-hash narinfo))
+ hash))))))))))))
+
+
(test-end)
;;; Local Variables: