summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/crate.scm357
-rw-r--r--tests/derivations.scm18
-rw-r--r--tests/gem.scm25
-rw-r--r--tests/guix-lint.sh11
-rw-r--r--tests/import-utils.scm23
-rw-r--r--tests/processes.scm40
6 files changed, 453 insertions, 21 deletions
diff --git a/tests/crate.scm b/tests/crate.scm
index c14862ad9f..61933a8de8 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -28,7 +28,7 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-64))
 
-(define test-crate
+(define test-foo-crate
   "{
   \"crate\": {
     \"max_version\": \"1.0.0\",
@@ -50,7 +50,7 @@
   }
 }")
 
-(define test-dependencies
+(define test-foo-dependencies
   "{
   \"dependencies\": [
      {
@@ -60,9 +60,182 @@
   ]
 }")
 
+(define test-root-crate
+  "{
+  \"crate\": {
+    \"max_version\": \"1.0.0\",
+    \"name\": \"root\",
+    \"description\": \"summary\",
+    \"homepage\": \"http://example.com\",
+    \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\" \"test\"],
+    \"categories\": [\"test\"]
+    \"actual_versions\": [
+      { \"id\": \"foo\",
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/root/1.0.0/dependencies\"
+        }
+      }
+    ]
+  }
+}")
+
+(define test-root-dependencies
+  "{
+  \"dependencies\": [
+     {
+       \"crate_id\": \"intermediate-1\",
+       \"kind\": \"normal\",
+     },
+     {
+       \"crate_id\": \"intermediate-2\",
+       \"kind\": \"normal\",
+     }
+     {
+       \"crate_id\": \"leaf-alice\",
+       \"kind\": \"normal\",
+     },
+     {
+       \"crate_id\": \"leaf-bob\",
+       \"kind\": \"normal\",
+     },
+  ]
+}")
+
+(define test-intermediate-1-crate
+  "{
+  \"crate\": {
+    \"max_version\": \"1.0.0\",
+    \"name\": \"intermediate-1\",
+    \"description\": \"summary\",
+    \"homepage\": \"http://example.com\",
+    \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\" \"test\"],
+    \"categories\": [\"test\"]
+    \"actual_versions\": [
+      { \"id\": \"intermediate-1\",
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/intermediate-1/1.0.0/dependencies\"
+        }
+      }
+    ]
+  }
+}")
+
+(define test-intermediate-1-dependencies
+  "{
+  \"dependencies\": [
+     {
+       \"crate_id\": \"intermediate-2\",
+       \"kind\": \"normal\",
+     },
+     {
+       \"crate_id\": \"leaf-alice\",
+       \"kind\": \"normal\",
+     },
+     {
+       \"crate_id\": \"leaf-bob\",
+       \"kind\": \"normal\",
+     }
+  ]
+}")
+
+(define test-intermediate-2-crate
+  "{
+  \"crate\": {
+    \"max_version\": \"1.0.0\",
+    \"name\": \"intermediate-2\",
+    \"description\": \"summary\",
+    \"homepage\": \"http://example.com\",
+    \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\" \"test\"],
+    \"categories\": [\"test\"]
+    \"actual_versions\": [
+      { \"id\": \"intermediate-2\",
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/intermediate-2/1.0.0/dependencies\"
+        }
+      }
+    ]
+  }
+}")
+
+(define test-intermediate-2-dependencies
+  "{
+  \"dependencies\": [
+     {
+       \"crate_id\": \"leaf-bob\",
+       \"kind\": \"normal\",
+     },
+  ]
+}")
+
+(define test-leaf-alice-crate
+  "{
+  \"crate\": {
+    \"max_version\": \"1.0.0\",
+    \"name\": \"leaf-alice\",
+    \"description\": \"summary\",
+    \"homepage\": \"http://example.com\",
+    \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\" \"test\"],
+    \"categories\": [\"test\"]
+    \"actual_versions\": [
+      { \"id\": \"leaf-alice\",
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/leaf-alice/1.0.0/dependencies\"
+        }
+      }
+    ]
+  }
+}")
+
+(define test-leaf-alice-dependencies
+  "{
+  \"dependencies\": []
+}")
+
+(define test-leaf-bob-crate
+  "{
+  \"crate\": {
+    \"max_version\": \"1.0.0\",
+    \"name\": \"leaf-bob\",
+    \"description\": \"summary\",
+    \"homepage\": \"http://example.com\",
+    \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\" \"test\"],
+    \"categories\": [\"test\"]
+    \"actual_versions\": [
+      { \"id\": \"leaf-bob\",
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/leaf-bob/1.0.0/dependencies\"
+        }
+      }
+    ]
+  }
+}")
+
+(define test-leaf-bob-dependencies
+  "{
+  \"dependencies\": []
+}")
+
 (define test-source-hash
   "")
 
+(define string->license
+  (@@ (guix import crate) string->license))
+
 (test-begin "crate")
 
 (test-equal "guix-package->crate-name"
@@ -79,14 +252,14 @@
          (lambda (url . rest)
            (match url
              ("https://crates.io/api/v1/crates/foo"
-              (open-input-string test-crate))
+              (open-input-string test-foo-crate))
              ("https://crates.io/api/v1/crates/foo/1.0.0/download"
               (set! test-source-hash
                 (bytevector->nix-base32-string
                  (sha256 (string->bytevector "empty file\n" "utf-8"))))
               (open-input-string "empty file\n"))
              ("https://crates.io/api/v1/crates/foo/1.0.0/dependencies"
-              (open-input-string test-dependencies))
+              (open-input-string test-foo-dependencies))
              (_ (error "Unexpected URL: " url)))))
     (match (crate->guix-package "foo")
       (('package
@@ -111,4 +284,180 @@
       (x
        (pk 'fail x #f)))))
 
+(test-assert "cargo-recursive-import"
+  ;; Replace network resources with sample data.
+  (mock ((guix http-client) http-fetch
+         (lambda (url . rest)
+           (match url
+             ("https://crates.io/api/v1/crates/root"
+              (open-input-string test-root-crate))
+             ("https://crates.io/api/v1/crates/root/1.0.0/download"
+              (set! test-source-hash
+                    (bytevector->nix-base32-string
+                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+              (open-input-string "empty file\n"))
+             ("https://crates.io/api/v1/crates/root/1.0.0/dependencies"
+              (open-input-string test-root-dependencies))
+             ("https://crates.io/api/v1/crates/intermediate-1"
+              (open-input-string test-intermediate-1-crate))
+             ("https://crates.io/api/v1/crates/intermediate-1/1.0.0/download"
+              (set! test-source-hash
+                    (bytevector->nix-base32-string
+                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+              (open-input-string "empty file\n"))
+             ("https://crates.io/api/v1/crates/intermediate-1/1.0.0/dependencies"
+              (open-input-string test-intermediate-1-dependencies))
+             ("https://crates.io/api/v1/crates/intermediate-2"
+              (open-input-string test-intermediate-2-crate))
+             ("https://crates.io/api/v1/crates/intermediate-2/1.0.0/download"
+              (set! test-source-hash
+                    (bytevector->nix-base32-string
+                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+              (open-input-string "empty file\n"))
+             ("https://crates.io/api/v1/crates/intermediate-2/1.0.0/dependencies"
+              (open-input-string test-intermediate-2-dependencies))
+             ("https://crates.io/api/v1/crates/leaf-alice"
+              (open-input-string test-leaf-alice-crate))
+             ("https://crates.io/api/v1/crates/leaf-alice/1.0.0/download"
+              (set! test-source-hash
+                    (bytevector->nix-base32-string
+                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+              (open-input-string "empty file\n"))
+             ("https://crates.io/api/v1/crates/leaf-alice/1.0.0/dependencies"
+              (open-input-string test-leaf-alice-dependencies))
+             ("https://crates.io/api/v1/crates/leaf-bob"
+              (open-input-string test-leaf-bob-crate))
+             ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/download"
+              (set! test-source-hash
+                    (bytevector->nix-base32-string
+                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+              (open-input-string "empty file\n"))
+             ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/dependencies"
+              (open-input-string test-leaf-bob-dependencies))
+             (_ (error "Unexpected URL: " url)))))
+        (match (crate-recursive-import "root")
+          ;; rust-intermediate-2 has no dependency on the rust-leaf-alice package, so this is a valid ordering
+          ((('package
+              ('name "rust-leaf-alice")
+              ('version (? string? ver))
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('crate-uri "leaf-alice" 'version))
+                 ('file-name
+                  ('string-append 'name "-" 'version ".tar.gz"))
+                 ('sha256
+                  ('base32
+                   (? string? hash)))))
+              ('build-system 'cargo-build-system)
+              ('home-page "http://example.com")
+              ('synopsis "summary")
+              ('description "summary")
+              ('license ('list 'license:expat 'license:asl2.0)))
+            ('package
+              ('name "rust-leaf-bob")
+              ('version (? string? ver))
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('crate-uri "leaf-bob" 'version))
+                 ('file-name
+                  ('string-append 'name "-" 'version ".tar.gz"))
+                 ('sha256
+                  ('base32
+                   (? string? hash)))))
+              ('build-system 'cargo-build-system)
+              ('home-page "http://example.com")
+              ('synopsis "summary")
+              ('description "summary")
+              ('license ('list 'license:expat 'license:asl2.0)))
+            ('package
+              ('name "rust-intermediate-2")
+              ('version (? string? ver))
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('crate-uri "intermediate-2" 'version))
+                 ('file-name
+                  ('string-append 'name "-" 'version ".tar.gz"))
+                 ('sha256
+                  ('base32
+                   (? string? hash)))))
+              ('build-system 'cargo-build-system)
+              ('arguments
+               ('quasiquote
+                ('#:cargo-inputs (("rust-leaf-bob" ('unquote rust-leaf-bob))))))
+              ('home-page "http://example.com")
+              ('synopsis "summary")
+              ('description "summary")
+              ('license ('list 'license:expat 'license:asl2.0)))
+            ('package
+              ('name "rust-intermediate-1")
+              ('version (? string? ver))
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('crate-uri "intermediate-1" 'version))
+                 ('file-name
+                  ('string-append 'name "-" 'version ".tar.gz"))
+                 ('sha256
+                  ('base32
+                   (? string? hash)))))
+              ('build-system 'cargo-build-system)
+              ('arguments
+               ('quasiquote
+                ('#:cargo-inputs (("rust-intermediate-2" ('unquote rust-intermediate-2))
+                                  ("rust-leaf-alice" ('unquote rust-leaf-alice))
+                                  ("rust-leaf-bob" ('unquote rust-leaf-bob))))))
+              ('home-page "http://example.com")
+              ('synopsis "summary")
+              ('description "summary")
+              ('license ('list 'license:expat 'license:asl2.0)))
+            ('package
+              ('name "rust-root")
+              ('version (? string? ver))
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('crate-uri "root" 'version))
+                 ('file-name
+                  ('string-append 'name "-" 'version ".tar.gz"))
+                 ('sha256
+                  ('base32
+                   (? string? hash)))))
+              ('build-system 'cargo-build-system)
+              ('arguments
+               ('quasiquote
+                ('#:cargo-inputs (("rust-intermediate-1" ('unquote rust-intermediate-1))
+                                  ("rust-intermediate-2" ('unquote rust-intermediate-2))
+                                  ("rust-leaf-alice" ('unquote rust-leaf-alice))
+                                  ("rust-leaf-bob" ('unquote rust-leaf-bob))))))
+              ('home-page "http://example.com")
+              ('synopsis "summary")
+              ('description "summary")
+              ('license ('list 'license:expat 'license:asl2.0))))
+           #t)
+          (x
+           (pk 'fail x #f)))))
+
+(test-equal "licenses: MIT OR Apache-2.0"
+  '(license:expat license:asl2.0)
+  (string->license "MIT OR Apache-2.0"))
+
+(test-equal "licenses: Apache-2.0 / MIT"
+  '(license:asl2.0 license:expat)
+  (string->license "Apache-2.0 / MIT"))
+
+(test-equal "licenses: Apache-2.0 WITH LLVM-exception"
+  '(license:asl2.0 unknown-license!)
+  (string->license "Apache-2.0 WITH LLVM-exception"))
+
+(test-equal "licenses: MIT/Apache-2.0 AND BSD-2-Clause"
+  '(license:expat license:asl2.0 unknown-license!)
+  (string->license "MIT/Apache-2.0 AND BSD-2-Clause"))
+
+(test-equal "licenses: MIT/Apache-2.0"
+  '(license:expat license:asl2.0)
+  (string->license "MIT/Apache-2.0"))
+
 (test-end "crate")
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 6a7fad85b5..ef6cec6c76 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -978,6 +978,24 @@
                                          #:mode (build-mode check))
                   (list drv dep))))))
 
+(test-assert "derivation-input-fold"
+  (let* ((builder (add-text-to-store %store "my-builder.sh"
+                                     "echo hello, world > \"$out\"\n"
+                                     '()))
+         (drv1    (derivation %store "foo"
+                              %bash `(,builder)
+                              #:sources `(,%bash ,builder)))
+         (drv2    (derivation %store "bar"
+                              %bash `(,builder)
+                              #:inputs `((,drv1))
+                              #:sources `(,%bash ,builder))))
+    (equal? (derivation-input-fold (lambda (input result)
+                                     (cons (derivation-input-derivation input)
+                                           result))
+                                   '()
+                                   (list (derivation-input drv2)))
+            (list drv1 drv2))))
+
 (test-assert "substitution-oracle and #:substitute? #f"
   (with-store store
     (let* ((dep   (build-expression->derivation store "dep"
diff --git a/tests/gem.scm b/tests/gem.scm
index a12edb294c..5158238d18 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -24,7 +24,6 @@
   #:use-module (gcrypt 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))
 
@@ -121,24 +120,23 @@
               (values (open-input-string test-bundler-json)
                       (string-length test-bundler-json)))
              (_ (error "Unexpected URL: " url)))))
-        (match (stream->list (gem-recursive-import "foo"))
+        (match (gem-recursive-import "foo")
           ((('package
-              ('name "ruby-foo")
+              ('name "ruby-bar")
               ('version "1.0.0")
               ('source
                ('origin
                  ('method 'url-fetch)
-                 ('uri ('rubygems-uri "foo" 'version))
+                 ('uri ('rubygems-uri "bar" '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")
+                (('"bundler" ('unquote 'bundler)))))
+              ('synopsis "Another cool gem")
+              ('description "Another cool gem")
               ('home-page "https://example.com")
               ('license ('list 'license:expat 'license:asl2.0)))
             ('package
@@ -157,21 +155,22 @@
               ('home-page "https://bundler.io/")
               ('license 'license:expat))
             ('package
-              ('name "ruby-bar")
+              ('name "ruby-foo")
               ('version "1.0.0")
               ('source
                ('origin
                  ('method 'url-fetch)
-                 ('uri ('rubygems-uri "bar" 'version))
+                 ('uri ('rubygems-uri "foo" 'version))
                  ('sha256
                   ('base32
                    "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
               ('build-system 'ruby-build-system)
               ('propagated-inputs
                ('quasiquote
-                (('"bundler" ('unquote 'bundler)))))
-              ('synopsis "Another cool gem")
-              ('description "Another cool gem")
+                (("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))))
            #t)
diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh
index 7ddc7c265b..f0df1fda3a 100644
--- a/tests/guix-lint.sh
+++ b/tests/guix-lint.sh
@@ -76,3 +76,14 @@ then true; else false; fi
 
 # Make sure specifying multiple packages works.
 guix lint -c inputs-should-be-native dummy dummy@42 dummy
+
+
+# Use --load-path instead.
+unset GUIX_PACKAGE_PATH
+
+out=`guix lint -L $module_dir -c synopsis,description dummy 2>&1`
+if [ `grep_warning "$out"` -ne 3 ]
+then false; else true; fi
+
+# Make sure specifying multiple packages works.
+guix lint -L $module_dir -c inputs-should-be-native dummy dummy@42 dummy
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index c3ab25d788..87dda3238f 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -24,7 +24,8 @@
   #:use-module (guix packages)
   #:use-module (guix build-system)
   #:use-module (gnu packages)
-  #:use-module (srfi srfi-64))
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 match))
 
 (test-begin "import-utils")
 
@@ -41,6 +42,26 @@
   'license:lgpl2.0
   (license->symbol license:lgpl2.0))
 
+(test-equal "recursive-import"
+  '((package                         ;package expressions in topological order
+      (name "bar"))
+    (package
+      (name "foo")
+      (inputs `(("bar" ,bar)))))
+  (recursive-import "foo" 'repo
+                    #:repo->guix-package
+                    (match-lambda*
+                      (("foo" 'repo)
+                       (values '(package
+                                  (name "foo")
+                                  (inputs `(("bar" ,bar))))
+                               '("bar")))
+                      (("bar" 'repo)
+                       (values '(package
+                                  (name "bar"))
+                               '())))
+                    #:guix-name identity))
+
 (test-assert "alist->package with simple source"
   (let* ((meta '(("name" . "hello")
                  ("version" . "2.10")
diff --git a/tests/processes.scm b/tests/processes.scm
index 40454bcbc7..ba518f2d9e 100644
--- a/tests/processes.scm
+++ b/tests/processes.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,15 +33,48 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads))
 
+;; When using --system argument, binfmt-misc mechanism may be used. In that
+;; case, (guix script processes) won't work because:
+;;
+;; * ARGV0 is qemu-user and not guix-daemon.
+;; * Guix-daemon won't be able to stuff client PID in ARGV1 of forked
+;;   processes.
+;;
+;; See: https://lists.gnu.org/archive/html/bug-guix/2019-12/msg00017.html.
+;;
+;; If we detect that we are running with binfmt emulation, all the following
+;; tests must be skipped.
+
+(define (binfmt-misc?)
+  (let ((pid (getpid))
+        (cmdline (call-with-input-file "/proc/self/cmdline" get-string-all)))
+    (match (primitive-fork)
+      (0 (dynamic-wind
+           (const #t)
+           (lambda ()
+             (exit
+              (not (equal?
+                    (call-with-input-file (format #f "/proc/~a/cmdline" pid)
+                      get-string-all)
+                    cmdline))))
+           (const #t)))
+      (x (zero? (cdr (waitpid x)))))))
+
+(define-syntax-rule (test-assert* description exp)
+  (begin
+    (when (binfmt-misc?)
+      (test-skip 1))
+    (test-assert description exp)))
+
 (test-begin "processes")
 
-(test-assert "not a client"
+(test-assert* "not a client"
   (not (find (lambda (session)
                (= (getpid)
                   (process-id (daemon-session-client session))))
              (daemon-sessions))))
 
-(test-assert "client"
+(test-assert* "client"
   (with-store store
     (let* ((session (find (lambda (session)
                             (= (getpid)
@@ -50,7 +84,7 @@
       (and (kill (process-id daemon) 0)
            (string-suffix? "guix-daemon" (first (process-command daemon)))))))
 
-(test-assert "client + lock"
+(test-assert* "client + lock"
   (with-store store
     (call-with-temporary-directory
      (lambda (directory)
generated by cgit-pink 1.4.1 (git 2.36.1) at 2025-02-20 22:16:57 +0000