gnu: gnunet-gtk: Update to 0.13.1.
[jackhill/guix/guix.git] / tests / store.scm
index 0e80ccc..ee3e01f 100644 (file)
@@ -22,7 +22,7 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix monads)
-  #:use-module (gcrypt hash)
+  #:use-module ((gcrypt hash) #:prefix gcrypt:)
   #:use-module (guix base32)
   #:use-module (guix packages)
   #:use-module (guix derivations)
                                 (passwd:name (getpwuid (getuid)))))))
     (list (stat:uid s) (stat:perms s))))
 
+(test-equal "add-to-store"
+  '("sha1" "sha256" "sha512" "sha3-256" "sha3-512" "blake2s-256")
+  (let* ((file    (search-path %load-path "guix.scm"))
+         (content (call-with-input-file file get-bytevector-all)))
+    (map (lambda (hash-algo)
+           (let ((file (add-to-store %store "guix.scm" #f hash-algo file)))
+             (and (direct-store-path? file)
+                  (bytevector=? (call-with-input-file file get-bytevector-all)
+                                content)
+                  hash-algo)))
+         '("sha1" "sha256" "sha512" "sha3-256" "sha3-512" "blake2s-256"))))
+
 (test-equal "add-data-to-store"
   #vu8(1 2 3 4 5)
   (call-with-input-file (add-data-to-store %store "data" #vu8(1 2 3 4 5))
                            #:env-vars `(("t2" . ,t2))))
            (o  (derivation->output-path d)))
       (with-derivation-narinfo d
-        (sha256 => (sha256 (string->utf8 t2)))
+        (sha256 => (gcrypt:sha256 (string->utf8 t2)))
         (references => (list t2))
 
         (equal? (references/substitutes s (list o t3 t2 t1))
       (run-with-store %store
         (mapm/accumulate-builds built-derivations `((,d1) (,d2)))))))
 
+(test-equal "mapm/accumulate-builds, %current-target-system"
+  (make-list 2 '("i586-pc-gnu" "i586-pc-gnu"))
+  ;; Both the 'mapm' and 'mapm/accumulate-builds' procedures should see the
+  ;; right #:target.
+  (run-with-store %store
+    (mlet %store-monad ((lst1 (mapm %store-monad
+                                    (lambda _
+                                      (current-target-system))
+                                    '(a b)))
+                        (lst2 (mapm/accumulate-builds
+                               (lambda _
+                                 (current-target-system))
+                               '(a b))))
+      (return (list lst1 lst2)))
+    #:system system
+    #:target "i586-pc-gnu"))
+
 (test-assert "topologically-sorted, one item"
   (let* ((a (add-text-to-store %store "a" "a"))
          (b (add-text-to-store %store "b" "b" (list a)))
         (foldm %store-monad
                (lambda (item result)
                  (define ref-hash
-                   (let-values (((port get) (open-sha256-port)))
+                   (let-values (((port get) (gcrypt:open-sha256-port)))
                      (write-file item port)
                      (close-port port)
                      (get)))
          (info (query-path-info %store item)))
     (and (equal? (path-info-references info) (list ref))
          (equal? (path-info-hash info)
-                 (sha256
+                 (gcrypt:sha256
                   (string->utf8
                    (call-with-output-string (cut write-file item <>))))))))