diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 46 | ||||
| -rw-r--r-- | tests/guix-package.sh | 21 | ||||
| -rw-r--r-- | tests/nar.scm | 3 | ||||
| -rw-r--r-- | tests/packages.scm | 22 | ||||
| -rw-r--r-- | tests/store.scm | 6 | ||||
| -rw-r--r-- | tests/utils.scm | 25 |
6 files changed, 112 insertions, 11 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index 6012e73216..a50c1af878 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -32,6 +32,7 @@ #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) + #:use-module (web uri) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 ftw) @@ -398,6 +399,51 @@ ;; prerequisite to build because DRV itself is already built. (null? (derivation-prerequisites-to-build %store drv))))) +(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1)) +(test-assert "derivation-prerequisites-to-build and substitutes" + (let*-values (((store) + (open-connection)) + ((drv-path drv) + (build-expression->derivation store "prereq-subst" + (%current-system) + (random 1000) '())) + ((output) + (derivation-output-path + (assoc-ref (derivation-outputs drv) "out"))) + ((dir) + (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") + (compose uri-path string->uri)))) + ;; Create fake substituter data, to be read by `substitute-binary'. + (call-with-output-file (string-append dir "/nix-cache-info") + (lambda (p) + (format p "StoreDir: ~a\nWantMassQuery: 0\n" + (%store-prefix)))) + (call-with-output-file (string-append dir "/" (store-path-hash-part output) + ".narinfo") + (lambda (p) + (format p "StorePath: ~a +URL: ~a +Compression: none +NarSize: 1234 +References: +System: ~a +Deriver: ~a~%" + output ; StorePath + (string-append dir "/example.nar") ; URL + (%current-system) ; System + (basename drv-path)))) ; Deriver + + (let-values (((build download) + (derivation-prerequisites-to-build store drv)) + ((build* download*) + (derivation-prerequisites-to-build store drv + #:use-substitutes? #f))) + (pk build download build* download*) + (and (null? build) + (equal? download (list output)) + (null? download*) + (null? build*))))) + (test-assert "build-expression->derivation with expression returning #f" (let* ((builder '(begin (mkdir %output) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index f84893ba0b..7b101aa501 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -62,18 +62,19 @@ then # name and version string. installed="`guix package -p "$profile" --list-installed | cut -f1 | xargs echo | sort`" case "x$installed" in - "guile-bootstrap make-boot0") - true;; - "make-boot0 guile-bootstrap") - true;; - "*") + "guile-bootstrap make-boot0") + true;; + "make-boot0 guile-bootstrap") + true;; + "*") false;; esac test "`guix package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap" # Search. - test "`guix package -s "GNU Hello" | grep ^name:`" = "name: hello" + test "`guix package -s "An example GNU package" | grep ^name:`" = \ + "name: hello" test "`guix package -s "n0t4r341p4ck4g3"`" = "" # Remove a package. @@ -92,10 +93,10 @@ then # Move to the empty profile. for i in `seq 1 3` do - guix package --bootstrap --roll-back -p "$profile" - ! test -f "$profile/bin" - ! test -f "$profile/lib" - test "`readlink_base "$profile"`" = "$profile-0-link" + guix package --bootstrap --roll-back -p "$profile" + ! test -f "$profile/bin" + ! test -f "$profile/lib" + test "`readlink_base "$profile"`" = "$profile-0-link" done # Reinstall after roll-back to the empty profile. diff --git a/tests/nar.scm b/tests/nar.scm index 4321cbda53..9bc5a1962e 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -196,7 +196,8 @@ (cut restore-file <> output)) (file-tree-equal? input output)) (lambda () - (false-if-exception (delete-file nar))))))) + (false-if-exception (delete-file nar)) + (false-if-exception (rm-rf output))))))) (lambda () (rmdir input))))) diff --git a/tests/packages.scm b/tests/packages.scm index 2d16f8a03f..1dd7b91ae8 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -53,6 +53,28 @@ (home-page #f) (license #f) extra-fields ...)) +(test-assert "package-field-location" + (let () + (define (goto port line column) + (unless (and (= (port-column port) (- column 1)) + (= (port-line port) (- line 1))) + (unless (eof-object? (get-char port)) + (goto port line column)))) + + (define read-at + (match-lambda + (($ <location> file line column) + (call-with-input-file (search-path %load-path file) + (lambda (port) + (goto port line column) + (read port)))))) + + (and (equal? (read-at (package-field-location %bootstrap-guile 'name)) + (package-name %bootstrap-guile)) + (equal? (read-at (package-field-location %bootstrap-guile 'version)) + (package-version %bootstrap-guile)) + (not (package-field-location %bootstrap-guile 'does-not-exist))))) + (test-assert "package-transitive-inputs" (let* ((a (dummy-package "a")) (b (dummy-package "b" diff --git a/tests/store.scm b/tests/store.scm index 4ee20a9352..677e39e75d 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -159,6 +159,12 @@ Deriver: ~a~%" (%current-system) ; System (basename d)))) ; Deriver + ;; Remove entry from the local cache. + (false-if-exception + (delete-file (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute-binary/" + (store-path-hash-part o)))) + ;; Make sure `substitute-binary' correctly communicates the above data. (set-build-options s #:use-substitutes? #t) (and (has-substitutes? s o) diff --git a/tests/utils.scm b/tests/utils.scm index bcdd120a74..fa7d7b03fd 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -64,6 +64,31 @@ ("nixpkgs" "1.0pre22125_a28fe19") ("gtk2" "2.38.0")))) +(test-equal "fold2, 1 list" + (list (reverse (iota 5)) + (map - (reverse (iota 5)))) + (call-with-values + (lambda () + (fold2 (lambda (i r1 r2) + (values (cons i r1) + (cons (- i) r2))) + '() '() + (iota 5))) + list)) + +(test-equal "fold2, 2 lists" + (list (reverse '((a . 0) (b . 1) (c . 2) (d . 3))) + (reverse '((a . 0) (b . -1) (c . -2) (d . -3)))) + (call-with-values + (lambda () + (fold2 (lambda (k v r1 r2) + (values (alist-cons k v r1) + (alist-cons k (- v) r2))) + '() '() + '(a b c d) + '(0 1 2 3))) + list)) + (test-assert "define-record-type*" (begin (define-record-type* <foo> foo make-foo |