summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2021-05-09 21:29:46 +0200
committerMarius Bakke <marius@gnu.org>2021-05-09 21:29:46 +0200
commitf03426420497cd9839f5fb3cb547dbecd8d6053b (patch)
tree220cdbab5b58b27c63d2df3ee711ad4bfdda074b /tests
parent3cf1afb7e7249992b2db2f4f00899fd22237e89a (diff)
parent069399ee9dbf75b7c89583f03346a63b2cfe4ac6 (diff)
downloadguix-f03426420497cd9839f5fb3cb547dbecd8d6053b.tar.gz
Merge branch 'master' into core-updates
 Conflicts:
	gnu/local.mk
	gnu/packages/bioinformatics.scm
	gnu/packages/django.scm
	gnu/packages/gtk.scm
	gnu/packages/llvm.scm
	gnu/packages/python-web.scm
	gnu/packages/python.scm
	gnu/packages/tex.scm
	guix/build-system/asdf.scm
	guix/build/emacs-build-system.scm
	guix/profiles.scm
Diffstat (limited to 'tests')
-rw-r--r--tests/go.scm8
-rw-r--r--tests/guix-package.sh2
-rw-r--r--tests/guix-system.sh8
-rw-r--r--tests/inferior.scm6
-rw-r--r--tests/lint.scm7
-rw-r--r--tests/records.scm18
-rw-r--r--tests/services/configuration.scm83
-rw-r--r--tests/snix.scm73
8 files changed, 117 insertions, 88 deletions
diff --git a/tests/go.scm b/tests/go.scm
index e5780e68b0..b088ab50d2 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -158,15 +158,11 @@ require github.com/kr/pretty v0.2.1
   "v1.0.2"
   (go-version->git-ref "v1.0.2"))
 
-(test-equal "go-version omited 'v' character"
-  "v1.0.2"
-  (go-version->git-ref "v1.0.2"))
-
-(test-equal "go-version with embeded git-ref"
+(test-equal "go-version with embedded git-ref"
   "65e3620a7ae7"
   (go-version->git-ref "v0.0.0-20190821162956-65e3620a7ae7"))
 
-(test-equal "go-version with complex embeded git-ref"
+(test-equal "go-version with complex embedded git-ref"
   "daa7c04131f5"
   (go-version->git-ref "v1.2.4-0.20191109021931-daa7c04131f5"))
 
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 39e2b514c3..92ab565c5b 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -459,7 +459,7 @@ if guix package --bootstrap -n -m "$module_dir/manifest.scm" \
 then false
 else
     cat "$module_dir/stderr"
-    grep "manifest.scm:[1-3]:.*wonderful-package.*: unbound variable" \
+    grep "manifest.scm:[1-4]:.*wonderful-package.*: unbound variable" \
 	 "$module_dir/stderr"
 fi
 
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 238c8929a8..7e992e7bdb 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -51,6 +51,7 @@ then
     # This must not succeed.
     exit 1
 else
+    cat "$errorfile"
     grep "$tmpfile:2:3:.*missing.* initializers" "$errorfile"
 fi
 
@@ -66,7 +67,12 @@ then
     # This must not succeed.
     exit 1
 else
-    grep "$tmpfile:4:1: missing closing paren" "$errorfile"
+    cat "$errorfile"
+
+    # Guile 3.0.6 gets line/column numbers for 'read-error' wrong
+    # (zero-indexed): <https://bugs.gnu.org/48089>.
+    grep "$tmpfile:4:1: missing closing paren" "$errorfile" || \
+    grep "$tmpfile:3:0: missing closing paren" "$errorfile"
 fi
 
 
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 7c3d730d0c..f227e0b749 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -173,9 +173,9 @@
                               ,(package-version package)
                               ,(package-location package))
                      ,@rest)))))
-    (list (map ->list (package-inputs guile-2.2))
-          (map ->list (package-native-inputs guile-2.2))
-          (map ->list (package-propagated-inputs guile-2.2))))
+    (list (map ->list (package-inputs guile-3.0-latest))
+          (map ->list (package-native-inputs guile-3.0-latest))
+          (map ->list (package-propagated-inputs guile-3.0-latest))))
   (let* ((inferior (open-inferior %top-builddir
                                   #:command "scripts/guix"))
          (guile    (first (lookup-inferior-packages inferior "guile")))
diff --git a/tests/lint.scm b/tests/lint.scm
index 47d5701b7d..02ffb19d78 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -270,6 +271,12 @@
                             (description "Imagine this is Taylor UUCP."))))
     (check-synopsis-style pkg)))
 
+(test-equal "name: use underscore in package name"
+  "name should use hyphens instead of underscores"
+  (single-lint-warning-message
+   (let ((pkg (dummy-package "under_score")))
+     (check-name pkg))))
+
 (test-equal "inputs: pkg-config is probably a native input"
   "'pkg-config' should probably be a native input"
   (single-lint-warning-message
diff --git a/tests/records.scm b/tests/records.scm
index 2c55a61720..706bb3dbfd 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +29,16 @@
     (module-use! module (resolve-interface '(guix records)))
     module))
 
+(define (location-alist loc)
+  ;; Return a location alist.  In Guile < 3.0.6, LOC is always an alist, but
+  ;; starting with 3.0.6, LOC is a vector (at least when it comes from
+  ;; 'syntax-error' exceptions), hence this conversion.
+  (match loc
+    (#(file line column)
+     `((line . ,line) (column . ,column)
+       (filename . ,file)))
+    (_ loc)))
+
 
 (test-begin "records")
 
@@ -298,7 +308,7 @@
                     (pk 'expected-loc
                         `((line . ,(- (assq-ref loc 'line) 1))
                           ,@(alist-delete 'line loc)))
-                    (pk 'actual-loc location)))))))
+                    (pk 'actual-loc (location-alist location))))))))
 
 (test-assert "define-record-type* & wrong field specifier, identifier"
   (let ((exp '(begin
@@ -325,7 +335,7 @@
                     (pk 'expected-loc
                         `((line . ,(- (assq-ref loc 'line) 2))
                           ,@(alist-delete 'line loc)))
-                    (pk 'actual-loc location)))))))
+                    (pk 'actual-loc (location-alist location))))))))
 
 (test-assert "define-record-type* & missing initializers"
   (catch 'syntax-error
@@ -396,7 +406,7 @@
                     (pk 'expected-loc
                         `((line . ,(- (assq-ref loc 'line) 1))
                           ,@(alist-delete 'line loc)))
-                    (pk 'actual-loc location)))))))
+                    (pk 'actual-loc (location-alist location))))))))
 
 (test-assert "ABI checks"
   (let ((module (test-module)))
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
new file mode 100644
index 0000000000..21ad188485
--- /dev/null
+++ b/tests/services/configuration.scm
@@ -0,0 +1,83 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; 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 (tests services linux)
+  #:use-module (gnu services configuration)
+  #:use-module (guix gexp)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-64))
+
+;;; Tests for the (gnu services configuration) module.
+
+(test-begin "services-configuration")
+
+
+;;;
+;;; define-configuration macro.
+;;;
+
+(define-configuration port-configuration
+  (port (number 80) "The port number.")
+  (no-serialization))
+
+(test-equal "default value, no serialization"
+  80
+  (port-configuration-port (port-configuration)))
+
+(define-configuration port-configuration-cs
+  (port (number 80) "The port number." empty-serializer))
+
+(test-equal "default value, custom serializer"
+  80
+  (port-configuration-cs-port (port-configuration-cs)))
+
+(define serialize-number "")
+(define-configuration port-configuration-ndv
+  (port (number) "The port number."))
+
+(test-equal "no default value, provided"
+  55
+  (port-configuration-ndv-port (port-configuration-ndv
+                                (port 55))))
+
+(test-assert "no default value, not provided"
+  (guard (c ((configuration-error? c)
+             #t))
+    (port-configuration-ndv-port (port-configuration-ndv))))
+
+(define (custom-number-serializer name value)
+  (format #t "~a = ~a;" name value))
+
+(define-configuration serializable-configuration
+  (port (number 80) "The port number." custom-number-serializer))
+
+(test-assert "serialize-configuration"
+  (gexp?
+   (let ((config (serializable-configuration)))
+     (serialize-configuration config serializable-configuration-fields))))
+
+(define-configuration serializable-configuration
+  (port (number 80) "The port number." custom-number-serializer)
+  (no-serialization))
+
+(test-assert "serialize-configuration with no-serialization"
+  ;; When serialization is disabled, the serializer is set to #f, so
+  ;; attempting to use it fails with a 'wrong-type-arg' error.
+  (not (false-if-exception
+        (let ((config (serializable-configuration)))
+          (serialize-configuration config serializable-configuration-fields)))))
diff --git a/tests/snix.scm b/tests/snix.scm
deleted file mode 100644
index 4c31e3389d..0000000000
--- a/tests/snix.scm
+++ /dev/null
@@ -1,73 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2015 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-snix)
-  #:use-module (guix import snix)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-64)
-  #:use-module (ice-9 match))
-
-(define %nixpkgs-directory
-  (getenv "NIXPKGS"))
-
-(define factorize-uri
-  (@@ (guix import snix) factorize-uri))
-
-(define-syntax-rule (every? proc lists ...)
-  (not (not (every proc lists ...))))
-
-(test-begin "snix")
-
-(test-assert "factorize-uri"
-  (every? (match-lambda
-           ((uri version '-> expected)
-            (equal? (factorize-uri uri version)
-                    expected)))
-          '(("http://example.com/foo.tgz" "1.0"
-             -> "http://example.com/foo.tgz")
-            ("http://example.com/foo-2.8.tgz" "2.8"
-             -> ("http://example.com/foo-" version ".tgz"))
-            ("http://example.com/2.8/foo-2.8.tgz" "2.8"
-             -> ("http://example.com/" version "/foo-" version ".tgz")))))
-
-(test-skip (if (and %nixpkgs-directory
-                    (file-exists? (string-append %nixpkgs-directory
-                                                 "/default.nix")))
-               0
-               1))
-
-(test-assert "nixpkgs->guix-package"
-  (match (nixpkgs->guix-package %nixpkgs-directory "guile")
-    (('package
-       ('name "guile")
-       ('version (? string?))
-       ('source ('origin _ ...))
-       ('build-system _)
-       ('inputs ('quasiquote (inputs ...)))
-       ('propagated-inputs ('quasiquote (pinputs ...)))
-       ('home-page (? string?))
-       ('synopsis (? string?))
-       ('description (? string?))
-       ('license (? symbol?)))
-     (and (member '("libffi" ,libffi) inputs)
-          (member '("gmp" ,gmp) pinputs)
-          #t))
-    (x
-     (pk 'fail x #f))))
-
-(test-end "snix")