summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2018-07-24 19:56:35 +0200
committerMarius Bakke <mbakke@fastmail.com>2018-07-24 19:56:35 +0200
commit706ae8e15c8d36b0aee7c19c54c143d3e17f5784 (patch)
treee9fe8ebfb1417d30979b5413165599f066a1c504 /tests
parent3e95125e9bd0676d4a9add9105217ad3eaef3ff0 (diff)
parent8440db459a10daa24282038f35bc0b6771bd51ab (diff)
downloadguix-706ae8e15c8d36b0aee7c19c54c143d3e17f5784.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/gem.scm108
-rw-r--r--tests/gexp.scm87
-rw-r--r--tests/guix-pack.sh5
-rw-r--r--tests/guix-package.sh12
-rw-r--r--tests/hackage.scm71
-rw-r--r--tests/hash.scm4
-rw-r--r--tests/inferior.scm69
-rw-r--r--tests/nar.scm62
-rw-r--r--tests/opam.scm118
-rw-r--r--tests/pypi.scm6
-rw-r--r--tests/store-database.scm7
-rw-r--r--tests/store-deduplication.scm4
-rw-r--r--tests/store.scm46
-rw-r--r--tests/syscalls.scm13
14 files changed, 558 insertions, 54 deletions
diff --git a/tests/gem.scm b/tests/gem.scm
index a39e8ba514..4220170ff0 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,10 +24,11 @@
   #:use-module (guix hash)
   #:use-module (guix tests)
   #:use-module ((guix build utils) #:select (delete-file-recursively))
+  #:use-module (srfi srfi-41)
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 match))
 
-(define test-json
+(define test-foo-json
   "{
   \"name\": \"foo\",
   \"version\": \"1.0.0\",
@@ -42,6 +44,34 @@
   \"licenses\": [\"MIT\", \"Apache 2.0\"]
 }")
 
+(define test-bar-json
+  "{
+  \"name\": \"bar\",
+  \"version\": \"1.0.0\",
+  \"sha\": \"f3676eafca9987cb5fe263df1edf2538bf6dafc712b30e17be3543a9680547a8\",
+  \"info\": \"Another cool gem\",
+  \"homepage_uri\": \"https://example.com\",
+  \"dependencies\": {
+    \"runtime\": [
+      { \"name\": \"bundler\" },
+    ]
+  },
+  \"licenses\": [\"MIT\", \"Apache 2.0\"]
+}")
+
+(define test-bundler-json
+  "{
+  \"name\": \"bundler\",
+  \"version\": \"1.14.2\",
+  \"sha\": \"3bb53e03db0a8008161eb4c816ccd317120d3c415ba6fee6f90bbc7f7eec8690\",
+  \"info\": \"Ruby gem bundler\",
+  \"homepage_uri\": \"https://bundler.io/\",
+  \"dependencies\": {
+    \"runtime\": []
+  },
+  \"licenses\": [\"MIT\"]
+}")
+
 (test-begin "gem")
 
 (test-assert "gem->guix-package"
@@ -50,8 +80,8 @@
          (lambda (url . rest)
            (match url
              ("https://rubygems.org/api/v1/gems/foo.json"
-              (values (open-input-string test-json)
-                      (string-length test-json)))
+              (values (open-input-string test-foo-json)
+                      (string-length test-foo-json)))
              (_ (error "Unexpected URL: " url)))))
     (match (gem->guix-package "foo")
       (('package
@@ -76,4 +106,76 @@
       (x
        (pk 'fail x #f)))))
 
+(test-assert "gem-recursive-import"
+  ;; Replace network resources with sample data.
+  (mock ((guix http-client) http-fetch
+         (lambda (url . rest)
+           (match url
+             ("https://rubygems.org/api/v1/gems/foo.json"
+              (values (open-input-string test-foo-json)
+                      (string-length test-foo-json)))
+             ("https://rubygems.org/api/v1/gems/bar.json"
+              (values (open-input-string test-bar-json)
+                      (string-length test-bar-json)))
+             ("https://rubygems.org/api/v1/gems/bundler.json"
+              (values (open-input-string test-bundler-json)
+                      (string-length test-bundler-json)))
+             (_ (error "Unexpected URL: " url)))))
+        (match (stream->list (gem-recursive-import "foo"))
+          ((('package
+              ('name "ruby-foo")
+              ('version "1.0.0")
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('rubygems-uri "foo" 'version))
+                 ('sha256
+                  ('base32
+                   "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+              ('build-system 'ruby-build-system)
+              ('propagated-inputs
+               ('quasiquote
+                (("bundler" ('unquote 'bundler))
+                 ("ruby-bar" ('unquote 'ruby-bar)))))
+              ('synopsis "A cool gem")
+              ('description "This package provides a cool gem")
+              ('home-page "https://example.com")
+              ('license ('list 'license:expat 'license:asl2.0)))
+            ('package
+              ('name "ruby-bundler")
+              ('version "1.14.2")
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('rubygems-uri "bundler" 'version))
+                 ('sha256
+                  ('base32
+                   "1446xiz7zg0bz7kgx9jv84y0s4hpsg61dj5l3qb0i00avc1kxd9v"))))
+              ('build-system 'ruby-build-system)
+              ('synopsis "Ruby gem bundler")
+              ('description "Ruby gem bundler")
+              ('home-page "https://bundler.io/")
+              ('license 'license:expat))
+            ('package
+              ('name "ruby-bar")
+              ('version "1.0.0")
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('rubygems-uri "bar" 'version))
+                 ('sha256
+                  ('base32
+                   "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+              ('build-system 'ruby-build-system)
+              ('propagated-inputs
+               ('quasiquote
+                (('"bundler" ('unquote 'bundler)))))
+              ('synopsis "Another cool gem")
+              ('description "Another cool gem")
+              ('home-page "https://example.com")
+              ('license ('list 'license:expat 'license:asl2.0))))
+           #t)
+          (x
+           (pk 'fail x #f)))))
+
 (test-end "gem")
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 83fe811546..b22e635805 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -635,18 +635,16 @@
                                             "guix/derivations.scm"))
                    ("p/q"   . ,(search-path %load-path "guix.scm"))
                    ("p/z"   . ,(search-path %load-path "guix/store.scm"))))
-       (drv (imported-files files)))
+       (dir (imported-files files)))
     (mbegin %store-monad
-      (built-derivations (list drv))
-      (let ((dir (derivation->output-path drv)))
-        (return
-         (every (match-lambda
-                 ((path . source)
-                  (equal? (call-with-input-file (string-append dir "/" path)
-                            get-bytevector-all)
-                          (call-with-input-file source
-                            get-bytevector-all))))
-                files))))))
+      (return
+       (every (match-lambda
+                ((path . source)
+                 (equal? (call-with-input-file (string-append dir "/" path)
+                           get-bytevector-all)
+                         (call-with-input-file source
+                           get-bytevector-all))))
+              files)))))
 
 (test-assertm "imported-files with file-like objects"
   (mlet* %store-monad ((plain -> (plain-file "foo" "bar!"))
@@ -654,16 +652,19 @@
                        (files -> `(("a/b/c" . ,q-scm)
                                    ("p/q"   . ,plain)))
                        (drv      (imported-files files)))
+    (define (file=? file1 file2)
+      ;; Assume deduplication is in place.
+      (= (stat:ino (lstat file1))
+         (stat:ino (lstat file2))))
+
     (mbegin %store-monad
       (built-derivations (list drv))
       (mlet %store-monad ((dir -> (derivation->output-path drv))
                           (plain* (text-file "foo" "bar!"))
                           (q-scm* (interned-file q-scm "c")))
         (return
-         (and (string=? (readlink (string-append dir "/a/b/c"))
-                        q-scm*)
-              (string=? (readlink (string-append dir "/p/q"))
-                        plain*)))))))
+         (and (file=? (string-append dir "/a/b/c") q-scm*)
+              (file=? (string-append dir "/p/q") plain*)))))))
 
 (test-equal "gexp-modules & ungexp"
   '((bar) (foo))
@@ -948,7 +949,7 @@
       (return (and (zero? (close-pipe pipe))
                    (= (expt n 2) (string->number str)))))))
 
-(test-assertm "gexp->script #:module-path"
+(test-assert "gexp->script #:module-path"
   (call-with-temporary-directory
    (lambda (directory)
      (define str
@@ -961,23 +962,24 @@
                         (define-public %fake! ,str))
                 port)))
 
-     (mlet* %store-monad ((exp -> (with-imported-modules '((guix base32))
-                                    (gexp (begin
-                                            (use-modules (guix base32))
-                                            (write (list %load-path
-                                                         %fake!))))))
-                          (drv    (gexp->script "guile-thing" exp
-                                                #:guile %bootstrap-guile
-                                                #:module-path (list directory)))
-                          (out -> (derivation->output-path drv))
-                          (done   (built-derivations (list drv))))
-       (let* ((pipe  (open-input-pipe out))
-              (data  (read pipe)))
-         (return (and (zero? (close-pipe pipe))
-                      (match data
-                        ((load-path str*)
-                         (and (string=? str* str)
-                              (not (member directory load-path))))))))))))
+     (run-with-store %store
+       (mlet* %store-monad ((exp -> (with-imported-modules '((guix base32))
+                                      (gexp (begin
+                                              (use-modules (guix base32))
+                                              (write (list %load-path
+                                                           %fake!))))))
+                            (drv    (gexp->script "guile-thing" exp
+                                                  #:guile %bootstrap-guile
+                                                  #:module-path (list directory)))
+                            (out -> (derivation->output-path drv))
+                            (done   (built-derivations (list drv))))
+         (let* ((pipe  (open-input-pipe out))
+                (data  (read pipe)))
+           (return (and (zero? (close-pipe pipe))
+                        (match data
+                          ((load-path str*)
+                           (and (string=? str* str)
+                                (not (member directory load-path)))))))))))))
 
 (test-assertm "program-file"
   (let* ((n      (random (expt 2 50)))
@@ -996,7 +998,7 @@
           (return (and (zero? (close-pipe pipe))
                        (= n (string->number str)))))))))
 
-(test-assertm "program-file #:module-path"
+(test-assert "program-file #:module-path"
   (call-with-temporary-directory
    (lambda (directory)
      (define text (random-text))
@@ -1014,14 +1016,15 @@
             (file   (program-file "program" exp
                                   #:guile %bootstrap-guile
                                   #:module-path (list directory))))
-       (mlet* %store-monad ((drv (lower-object file))
-                            (out -> (derivation->output-path drv)))
-         (mbegin %store-monad
-           (built-derivations (list drv))
-           (let* ((pipe  (open-input-pipe out))
-                  (str   (get-string-all pipe)))
-             (return (and (zero? (close-pipe pipe))
-                          (string=? text str))))))))))
+       (run-with-store %store
+         (mlet* %store-monad ((drv (lower-object file))
+                              (out -> (derivation->output-path drv)))
+           (mbegin %store-monad
+             (built-derivations (list drv))
+             (let* ((pipe  (open-input-pipe out))
+                    (str   (get-string-all pipe)))
+               (return (and (zero? (close-pipe pipe))
+                            (string=? text str)))))))))))
 
 (test-assertm "program-file & with-extensions"
   (let* ((exp    (with-extensions (list %extension-package)
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 917d52451c..bf367fa429 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -28,6 +28,11 @@ fi
 
 guix pack --version
 
+# FIXME: Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa,
+# '--bootstrap' is mostly ineffective since 'guix pack' produces derivations
+# that refer to guile-sqlite3 and libgcrypt.  For now we just skip the test.
+exit 77
+
 # Use --no-substitutes because we need to verify we can do this ourselves.
 GUIX_BUILD_OPTIONS="--no-substitutes"
 export GUIX_BUILD_OPTIONS
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 3b3fa35cd8..cef3b3452e 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -185,6 +185,16 @@ grep -E 'emacs[[:blank:]]+42\.5\.9rc7[[:blank:]]+.*-emacs-42.5.9rc7' \
 rm "$emacs_tarball" "$tmpfile"
 rmdir "$module_dir"
 
+# Profiles with a relative file name.  Make sure we don't create dangling
+# symlinks--see bug report at
+# <https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00036.html>.
+mkdir -p "$module_dir/foo"
+( cd "$module_dir" ;						\
+  guix package --bootstrap -i guile-bootstrap -p foo/prof )
+test -f "$module_dir/foo/prof/bin/guile"
+rm "$module_dir/foo"/*
+rmdir "$module_dir/foo"
+rmdir "$module_dir"
 
 #
 # Try with the default profile.
@@ -215,7 +225,7 @@ do
     guix package --bootstrap --roll-back
     ! test -f "$HOME/.guix-profile/bin"
     ! test -f "$HOME/.guix-profile/lib"
-    test "`readlink "$default_profile"`" = "$default_profile-0-link"
+    test "`readlink "$default_profile"`" = "`basename $default_profile-0-link`"
 done
 
 # Check whether '-p ~/.guix-profile' makes any difference.
diff --git a/tests/hackage.scm b/tests/hackage.scm
index a4de8be91e..e17851a213 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -69,6 +69,65 @@ library
       mtl        >= 2.0      && < 3
 ")
 
+;; Check "-any", "-none" when name is different.
+(define test-cabal-4
+  "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+  if impl(ghcjs -any)
+    Build-depends: ghc-a
+  if impl(ghc>=7.2&&<7.6)
+    Build-depends: ghc-b
+  if impl(ghc == 7.8)
+    Build-depends: 
+      HTTP       >= 4000.2.5 && < 4000.3,
+      mtl        >= 2.0      && < 3
+")
+
+;; Check "-any", "-none".
+(define test-cabal-5
+  "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+  if impl(ghc == 7.8)
+    Build-depends: 
+      HTTP       >= 4000.2.5 && < 4000.3,
+  if impl(ghc -any)
+    Build-depends: mtl        >= 2.0      && < 3
+  if impl(ghc>=7.2&&<7.6)
+    Build-depends: ghc-b
+")
+
+;; Check "custom-setup".
+(define test-cabal-6
+  "name: foo
+build-type: Custom
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+custom-setup
+  setup-depends: base >= 4.7 && < 5,
+                 Cabal >= 1.24,
+                 haskell-gi == 0.21.*
+library
+  if impl(ghc>=7.2&&<7.6)
+    Build-depends: ghc-b
+  if impl(ghc == 7.8)
+    Build-depends: 
+      HTTP       >= 4000.2.5 && < 4000.3,
+      mtl        >= 2.0      && < 3
+")
+
 ;; A fragment of a real Cabal file with minor modification to check precedence
 ;; of 'and' over 'or', missing final newline, spaces between keywords and
 ;; parentheses and between key and column.
@@ -139,6 +198,18 @@ library
   (eval-test-with-cabal test-cabal-3
                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 
+(test-assert "hackage->guix-package test 4"
+  (eval-test-with-cabal test-cabal-4
+                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+
+(test-assert "hackage->guix-package test 5"
+  (eval-test-with-cabal test-cabal-5
+                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+
+(test-assert "hackage->guix-package test 6"
+  (eval-test-with-cabal test-cabal-6
+                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)
     ((("name" ("test-me"))
diff --git a/tests/hash.scm b/tests/hash.scm
index da87616eec..47dff3915b 100644
--- a/tests/hash.scm
+++ b/tests/hash.scm
@@ -64,12 +64,12 @@
     (get)))
 
 (test-equal "open-sha256-port, hello"
-  %hello-sha256
+  (list %hello-sha256 (string-length "hello world"))
   (let-values (((port get)
                 (open-sha256-port)))
     (put-bytevector port (string->utf8 "hello world"))
     (force-output port)
-    (get)))
+    (list (get) (port-position port))))
 
 (test-assert "port-sha256"
   (let* ((file     (search-path %load-path "ice-9/psyntax.scm"))
diff --git a/tests/inferior.scm b/tests/inferior.scm
new file mode 100644
index 0000000000..5e0f8ae66e
--- /dev/null
+++ b/tests/inferior.scm
@@ -0,0 +1,69 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-inferior)
+  #:use-module (guix inferior)
+  #:use-module (guix packages)
+  #:use-module (gnu packages)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+(define %top-srcdir
+  (dirname (search-path %load-path "guix.scm")))
+
+(define %top-builddir
+  (dirname (search-path %load-compiled-path "guix.go")))
+
+
+(test-begin "inferior")
+
+(test-equal "open-inferior"
+  '(42 #t)
+  (let ((inferior (open-inferior %top-builddir
+                                 #:command "scripts/guix")))
+    (and (inferior? inferior)
+         (let ((a (inferior-eval '(apply * '(6 7)) inferior))
+               (b (inferior-eval '(@ (gnu packages base) coreutils)
+                                 inferior)))
+           (close-inferior inferior)
+           (list a (inferior-object? b))))))
+
+(test-equal "inferior-packages"
+  (take (sort (fold-packages (lambda (package lst)
+                               (alist-cons (package-name package)
+                                           (package-version package)
+                                           lst))
+                             '())
+              (lambda (x y)
+                (string<? (car x) (car y))))
+        10)
+  (let* ((inferior (open-inferior %top-builddir
+                                  #:command "scripts/guix"))
+         (packages (inferior-packages inferior)))
+    (and (every string? (map inferior-package-synopsis packages))
+         (begin
+           (close-inferior inferior)
+           (take (sort (map (lambda (package)
+                              (cons (inferior-package-name package)
+                                    (inferior-package-version package)))
+                            packages)
+                       (lambda (x y)
+                         (string<? (car x) (car y))))
+                 10)))))
+
+(test-end "inferior")
diff --git a/tests/nar.scm b/tests/nar.scm
index 61646db964..9b5fb984b4 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -152,6 +152,66 @@
 
 (test-begin "nar")
 
+(test-assert "write-file-tree + restore-file"
+  (let* ((file1  (search-path %load-path "guix.scm"))
+         (file2  (search-path %load-path "guix/base32.scm"))
+         (file3  "#!/bin/something")
+         (output (string-append %test-dir "/output")))
+    (dynamic-wind
+      (lambda () #t)
+      (lambda ()
+        (define-values (port get-bytevector)
+          (open-bytevector-output-port))
+        (write-file-tree "root" port
+                         #:file-type+size
+                         (match-lambda
+                           ("root"
+                            (values 'directory 0))
+                           ("root/foo"
+                            (values 'regular (stat:size (stat file1))))
+                           ("root/lnk"
+                            (values 'symlink 0))
+                           ("root/dir"
+                            (values 'directory 0))
+                           ("root/dir/bar"
+                            (values 'regular (stat:size (stat file2))))
+                           ("root/dir/exe"
+                            (values 'executable (string-length file3))))
+                         #:file-port
+                         (match-lambda
+                           ("root/foo" (open-input-file file1))
+                           ("root/dir/bar" (open-input-file file2))
+                           ("root/dir/exe" (open-input-string file3)))
+                         #:symlink-target
+                         (match-lambda
+                           ("root/lnk" "foo"))
+                         #:directory-entries
+                         (match-lambda
+                           ("root" '("foo" "dir" "lnk"))
+                           ("root/dir" '("bar" "exe"))))
+        (close-port port)
+
+        (rm-rf %test-dir)
+        (mkdir %test-dir)
+        (restore-file (open-bytevector-input-port (get-bytevector))
+                      output)
+        (and (file=? (string-append output "/foo") file1)
+             (string=? (readlink (string-append output "/lnk"))
+                       "foo")
+             (file=? (string-append output "/dir/bar") file2)
+             (string=? (call-with-input-file (string-append output "/dir/exe")
+                         get-string-all)
+                       file3)
+             (> (logand (stat:mode (lstat (string-append output "/dir/exe")))
+                        #o100)
+                0)
+             (equal? '("." ".." "bar" "exe")
+                     (scandir (string-append output "/dir")))
+             (equal? '("." ".." "dir" "foo" "lnk")
+                     (scandir output))))
+      (lambda ()
+        (false-if-exception (rm-rf %test-dir))))))
+
 (test-assert "write-file supports non-file output ports"
   (let ((input  (string-append (dirname (search-path %load-path "guix.scm"))
                                "/guix"))
diff --git a/tests/opam.scm b/tests/opam.scm
new file mode 100644
index 0000000000..26832174a8
--- /dev/null
+++ b/tests/opam.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-opam)
+  #:use-module (guix import opam)
+  #:use-module (guix base32)
+  #:use-module (guix hash)
+  #:use-module (guix tests)
+  #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which))
+  #:use-module (srfi srfi-64)
+  #:use-module (web uri)
+  #:use-module (ice-9 match))
+
+(define test-url-file
+  "http: \"https://example.org/foo-1.0.0.tar.gz\"
+checksum: \"ac8920f39a8100b94820659bc2c20817\"")
+
+(define test-source-hash
+  "")
+
+(define test-urls
+  "repo ac8920f39a8100b94820659bc2c20817 0o644
+packages/foo/foo.1.0.0/url ac8920f39a8100b94820659bc2c20817 0o644
+packages/foo/foo.1.0.0/opam ac8920f39a8100b94820659bc2c20817 0o644
+packages/foo/foo.1.0.0/descr ac8920f39a8100b94820659bc2c20817 0o644")
+
+(define test-opam-file
+"opam-version: 1.2
+maintainer: \"Alice Doe\"
+authors: \"Alice Doe, John Doe\"
+homepage: \"https://example.org/\"
+bug-reports: \"https://example.org/bugs\"
+license: \"MIT\"
+dev-repo: \"https://example.org/git\"
+build: [
+  \"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"
+]
+build-test: [
+  \"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\" \"true\"
+]
+depends: [
+  \"alcotest\" {test & >= \"0.7.2\"}
+  \"ocamlbuild\" {build & >= \"0.9.2\"}
+]")
+
+(test-begin "opam")
+
+(test-assert "opam->guix-package"
+  ;; Replace network resources with sample data.
+    (mock ((guix import utils) url-fetch
+           (lambda (url file-name)
+             (match url
+               ("https://example.org/foo-1.0.0.tar.gz"
+                (begin
+                  (mkdir-p "foo-1.0.0")
+                  (system* "tar" "czvf" file-name "foo-1.0.0/")
+                  (delete-file-recursively "foo-1.0.0")
+                  (set! test-source-hash
+                    (call-with-input-file file-name port-sha256))))
+               (_ (error "Unexpected URL: " url)))))
+          (mock ((guix http-client) http-fetch/cached
+                 (lambda (url . rest)
+                   (match (uri->string url)
+                     ("https://opam.ocaml.org/urls.txt"
+                      (values (open-input-string test-urls)
+                              (string-length test-urls)))
+                     (_ (error "Unexpected URL: " url)))))
+                (mock ((guix http-client) http-fetch
+                       (lambda (url . rest)
+                         (match url
+                           ("https://opam.ocaml.org/packages/foo/foo.1.0.0/url"
+                            (values (open-input-string test-url-file)
+                                    (string-length test-url-file)))
+                           ("https://opam.ocaml.org/packages/foo/foo.1.0.0/opam"
+                            (values (open-input-string test-opam-file)
+                                    (string-length test-opam-file)))
+                           (_ (error "Unexpected URL: " url)))))
+                      (match (opam->guix-package "foo")
+                        (('package
+                           ('name "ocaml-foo")
+                           ('version "1.0.0")
+                           ('source ('origin
+                                      ('method 'url-fetch)
+                                      ('uri "https://example.org/foo-1.0.0.tar.gz")
+                                      ('sha256
+                                       ('base32
+                                        (? string? hash)))))
+                           ('build-system 'ocaml-build-system)
+                           ('inputs
+                            ('quasiquote
+                             (("ocamlbuild" ('unquote 'ocamlbuild))
+                              ("ocaml-alcotest" ('unquote 'ocaml-alcotest)))))
+                           ('home-page "https://example.org/")
+                           ('synopsis "")
+                           ('description "")
+                           ('license 'license:expat))
+                         (string=? (bytevector->nix-base32-string
+                                    test-source-hash)
+                                   hash))
+                        (x
+                         (pk 'fail x #f)))))))
+
+(test-end "opam")
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 74f13e9662..310c6c8f29 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -89,7 +89,7 @@ baz > 13.37")
    (dummy-package "foo"
                   (source (dummy-origin
                            (uri
-                            "https://pypi.python.org/packages/a2/3b/4756e6a0ceb14e084042a2a65c615d68d25621c6fd446d0fc10d14c4ce7d/certbot-0.8.1.tar.gz"))))))
+                            "https://pypi.org/packages/a2/3b/4756e6a0ceb14e084042a2a65c615d68d25621c6fd446d0fc10d14c4ce7d/certbot-0.8.1.tar.gz"))))))
 
 (test-equal "guix-package->pypi-name, several URLs"
   "cram"
@@ -120,7 +120,7 @@ baz > 13.37")
           (mock ((guix http-client) http-fetch
                  (lambda (url . rest)
                    (match url
-                     ("https://pypi.python.org/pypi/foo/json"
+                     ("https://pypi.org/pypi/foo/json"
                       (values (open-input-string test-json)
                               (string-length test-json)))
                      ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
@@ -182,7 +182,7 @@ baz > 13.37")
         (mock ((guix http-client) http-fetch
                (lambda (url . rest)
                  (match url
-                   ("https://pypi.python.org/pypi/foo/json"
+                   ("https://pypi.org/pypi/foo/json"
                     (values (open-input-string test-json)
                             (string-length test-json)))
                    ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
diff --git a/tests/store-database.scm b/tests/store-database.scm
index fcae66e2de..4d91884250 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -32,7 +32,8 @@
 
 (test-begin "store-database")
 
-(test-assert "register-path"
+(test-equal "register-path"
+  '(1 1)
   (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f)
                              "-fake")))
     (when (valid-path? %store file)
@@ -50,7 +51,9 @@
       (and (valid-path? %store file)
            (equal? (references %store file) (list ref))
            (null? (valid-derivers %store file))
-           (null? (referrers %store file))))))
+           (null? (referrers %store file))
+           (list (stat:mtime (lstat file))
+                 (stat:mtime (lstat ref)))))))
 
 (test-equal "new database"
   (list 1 2)
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index 2361723199..4ca2ec0f61 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -47,6 +47,10 @@
                      (lambda (port)
                        (put-bytevector port data))))
                  identical)
+       ;; Make the parent of IDENTICAL read-only.  This should not prevent
+       ;; deduplication for inserting its hard link.
+       (chmod (dirname (second identical)) #o544)
+
        (call-with-output-file unique
          (lambda (port)
            (put-bytevector port (string->utf8 "This is unique."))))
diff --git a/tests/store.scm b/tests/store.scm
index afecec940a..47fab0df18 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -210,6 +210,52 @@
            (valid-path? store path)
            (file-exists? path)))))
 
+(test-equal "add-file-tree-to-store"
+  `(42
+    ("." directory #t)
+    ("./bar" directory #t)
+    ("./foo" directory #t)
+    ("./foo/a" regular "file a")
+    ("./foo/b" symlink "a")
+    ("./foo/c" directory #t)
+    ("./foo/c/p" regular "file p")
+    ("./foo/c/q" directory #t)
+    ("./foo/c/q/x" regular "#!/bin/sh\nexit 42")
+    ("./foo/c/q/y" symlink "..")
+    ("./foo/c/q/z" directory #t))
+  (let* ((tree  `("file-tree" directory
+                  ("foo" directory
+                   ("a" regular (data "file a"))
+                   ("b" symlink "a")
+                   ("c" directory
+                    ("p" regular (data ,(string->utf8 "file p")))
+                    ("q" directory
+                     ("x" executable
+                      (data "#!/bin/sh\nexit 42"))
+                     ("y" symlink "..")
+                     ("z" directory))))
+                  ("bar" directory)))
+         (result (add-file-tree-to-store %store tree)))
+    (cons (status:exit-val (system* (string-append result "/foo/c/q/x")))
+          (with-directory-excursion result
+            (map (lambda (file)
+                   (let ((type (stat:type (lstat file))))
+                     `(,file ,type
+                             ,(match type
+                                ((or 'regular 'executable)
+                                 (call-with-input-file file
+                                   get-string-all))
+                                ('symlink (readlink file))
+                                ('directory #t)))))
+                 (find-files "." #:directories? #t))))))
+
+(test-equal "add-file-tree-to-store, flat"
+  "Hello, world!"
+  (let* ((tree   `("flat-file" regular (data "Hello, world!")))
+         (result (add-file-tree-to-store %store tree)))
+    (and (file-exists? result)
+         (call-with-input-file result get-string-all))))
+
 (test-assert "references"
   (let* ((t1 (add-text-to-store %store "random1"
                                 (random-text)))
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 0d07280b99..3e267c9f01 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -60,6 +60,19 @@
   (any (cute member <> (mount-points))
        '("/" "/proc" "/sys" "/dev")))
 
+(false-if-exception (delete-file temp-file))
+(test-equal "utime with AT_SYMLINK_NOFOLLOW"
+  '(0 0)
+  (begin
+    ;; Test libguile's utime with AT_SYMLINK_NOFOLLOW, which libguile does not
+    ;; define as of Guile 2.2.4.
+    (symlink "/nowhere" temp-file)
+    (utime temp-file 0 0 0 0 AT_SYMLINK_NOFOLLOW)
+    (let ((st (lstat temp-file)))
+      (delete-file temp-file)
+      ;; Note: 'utimensat' does not change 'ctime'.
+      (list (stat:mtime st) (stat:atime st)))))
+
 (test-assert "swapon, ENOENT/EPERM"
   (catch 'system-error
     (lambda ()