summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/cpan.scm114
-rw-r--r--tests/cran.scm6
-rw-r--r--tests/crate.scm5
-rw-r--r--tests/elpa.scm101
-rw-r--r--tests/guix-graph.sh27
-rw-r--r--tests/guix-system.sh29
-rw-r--r--tests/lint.scm18
-rw-r--r--tests/lzlib.scm3
-rw-r--r--tests/opam.scm67
-rw-r--r--tests/packages.scm11
-rw-r--r--tests/publish.scm8
-rw-r--r--tests/records.scm34
-rw-r--r--tests/texlive.scm14
13 files changed, 233 insertions, 204 deletions
diff --git a/tests/cpan.scm b/tests/cpan.scm
index 189dd027e6..b4db9e60e4 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
+;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,9 +22,10 @@
#:use-module (guix import cpan)
#:use-module (guix base32)
#:use-module (gcrypt hash)
- #:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module (guix grafts)
#:use-module (srfi srfi-64)
+ #:use-module (web client)
#:use-module (ice-9 match))
;; Globally disable grafts because they can trigger early builds.
@@ -32,13 +34,6 @@
(define test-json
"{
\"metadata\" : {
- \"prereqs\" : {
- \"runtime\" : {
- \"requires\" : {
- \"Test::Script\" : \"1.05\",
- }
- }
- }
\"name\" : \"Foo-Bar\",
\"version\" : \"0.1\"
}
@@ -47,6 +42,13 @@
\"license\" : [
\"perl_5\"
],
+ \"dependency\": [
+ { \"relationship\": \"requires\",
+ \"phase\": \"runtime\",
+ \"version\": \"1.05\",
+ \"module\": \"Test::Script\"
+ }
+ ],
\"abstract\" : \"Fizzle Fuzz\",
\"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
\"author\" : \"Guix\",
@@ -56,67 +58,51 @@
(define test-source
"foobar")
+;; Avoid collisions with other tests.
+(%http-server-port 10400)
+
(test-begin "cpan")
(test-assert "cpan->guix-package"
;; Replace network resources with sample data.
- (mock ((guix build download) url-fetch
- (lambda* (url file-name
- #:key
- (mirrors '()) verify-certificate?)
- (with-output-to-file file-name
- (lambda ()
- (display
- (match url
- ("http://example.com/Foo-Bar-0.1.tar.gz"
- test-source)
- (_ (error "Unexpected URL: " url))))))))
- (mock ((guix http-client) http-fetch
- (lambda (url . rest)
- (match url
- ("https://fastapi.metacpan.org/v1/release/Foo-Bar"
- (values (open-input-string test-json)
- (string-length test-json)))
- ("https://fastapi.metacpan.org/v1/module/Test::Script?fields=distribution"
- (let ((result "{ \"distribution\" : \"Test-Script\" }"))
- (values (open-input-string result)
- (string-length result))))
- (_ (error "Unexpected URL: " url)))))
- (match (cpan->guix-package "Foo::Bar")
- (('package
- ('name "perl-foo-bar")
- ('version "0.1")
- ('source ('origin
- ('method 'url-fetch)
- ('uri ('string-append "http://example.com/Foo-Bar-"
- 'version ".tar.gz"))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'perl-build-system)
- ('propagated-inputs
- ('quasiquote
- (("perl-test-script" ('unquote 'perl-test-script)))))
- ('home-page "https://metacpan.org/release/Foo-Bar")
- ('synopsis "Fizzle Fuzz")
- ('description 'fill-in-yourself!)
- ('license 'perl-license))
- (string=? (bytevector->nix-base32-string
- (call-with-input-string test-source port-sha256))
- hash))
- (x
- (pk 'fail x #f))))))
+ (with-http-server `((200 ,test-json)
+ (200 ,test-source)
+ (200 "{ \"distribution\" : \"Test-Script\" }"))
+ (parameterize ((%metacpan-base-url (%local-url))
+ (current-http-proxy (%local-url)))
+ (match (cpan->guix-package "Foo::Bar")
+ (('package
+ ('name "perl-foo-bar")
+ ('version "0.1")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri ('string-append "http://example.com/Foo-Bar-"
+ 'version ".tar.gz"))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'perl-build-system)
+ ('propagated-inputs
+ ('quasiquote
+ (("perl-test-script" ('unquote 'perl-test-script)))))
+ ('home-page "https://metacpan.org/release/Foo-Bar")
+ ('synopsis "Fizzle Fuzz")
+ ('description 'fill-in-yourself!)
+ ('license 'perl-license))
+ (string=? (bytevector->nix-base32-string
+ (call-with-input-string test-source port-sha256))
+ hash))
+ (x
+ (pk 'fail x #f))))))
-(test-equal "source-url-http"
- ((@@ (guix import cpan) cpan-source-url)
- `(("download_url" .
- "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))
- "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
+(test-equal "metacpan-url->mirror-url, http"
+ "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
+ (metacpan-url->mirror-url
+ "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))
-(test-equal "source-url-https"
- ((@@ (guix import cpan) cpan-source-url)
- `(("download_url" .
- "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))
- "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
+(test-equal "metacpan-url->mirror-url, https"
+ "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
+ (metacpan-url->mirror-url
+ "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))
(test-end "cpan")
diff --git a/tests/cran.scm b/tests/cran.scm
index d785ec5db1..70d2277198 100644
--- a/tests/cran.scm
+++ b/tests/cran.scm
@@ -53,7 +53,7 @@ Date/Publication: 2015-07-14 14:15:16
")
(define description-alist
- ((@@ (guix import cran) description->alist) description))
+ (description->alist description))
(define simple-alist
'(("Key" . "Value")
@@ -72,7 +72,7 @@ Date/Publication: 2015-07-14 14:15:16
"Date/Publication")))
(lset= string=? keys (map car description-alist))))
-(test-equal "listify: return empty list if key cannot be found"
+(test-equal "listifyx: return empty list if key cannot be found"
'()
((@@ (guix import cran) listify) simple-alist "Letters"))
@@ -105,7 +105,7 @@ Date/Publication: 2015-07-14 14:15:16
("mirror://cran/src/contrib/My-Example_1.2.3.tar.gz"
"source")
(_ (error "Unexpected URL: " url))))))))
- (match ((@@ (guix import cran) description->package) 'cran description-alist)
+ (match (description->package 'cran description-alist)
(('package
('name "r-my-example")
('version "1.2.3")
diff --git a/tests/crate.scm b/tests/crate.scm
index 61933a8de8..aa51faebf9 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -233,9 +233,6 @@
(define test-source-hash
"")
-(define string->license
- (@@ (guix import crate) string->license))
-
(test-begin "crate")
(test-equal "guix-package->crate-name"
diff --git a/tests/elpa.scm b/tests/elpa.scm
index 44e3914f2e..b70539bda6 100644
--- a/tests/elpa.scm
+++ b/tests/elpa.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,10 +19,11 @@
(define-module (test-elpa)
#:use-module (guix import elpa)
- #:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
- #:use-module (ice-9 match))
+ #:use-module (ice-9 match)
+ #:use-module (web client))
(define elpa-mock-archive
'(1
@@ -37,77 +39,42 @@
nil "Integrated environment for *TeX*" tar
((:url . "http://www.gnu.org/software/auctex/"))])))
-(define auctex-readme-mock "This is the AUCTeX description.")
-
-(define* (elpa-package-info-mock name #:optional (repo "gnu"))
- "Simulate retrieval of 'archive-contents' file from REPO and extraction of
-information about package NAME. (Function 'elpa-package-info'.)"
- (let* ((archive elpa-mock-archive)
- (info (filter (lambda (p) (eq? (first p) (string->symbol name)))
- (cdr archive))))
- (if (pair? info) (first info) #f)))
-
-(define elpa-version->string
- (@@ (guix import elpa) elpa-version->string))
-
-(define package-source-url
- (@@ (guix import elpa) package-source-url))
-
-(define ensure-list
- (@@ (guix import elpa) ensure-list))
-
-(define package-home-page
- (@@ (guix import elpa) package-home-page))
-
-(define make-elpa-package
- (@@ (guix import elpa) make-elpa-package))
+;; Avoid collisions with other tests.
+(%http-server-port 10300)
(test-begin "elpa")
(define (eval-test-with-elpa pkg)
- (mock
- ;; replace the two fetching functions
- ((guix import elpa) fetch-elpa-package
- (lambda* (name #:optional (repo "gnu"))
- (let ((pkg (elpa-package-info-mock name repo)))
- (match pkg
- ((name version reqs synopsis kind . rest)
- (let* ((name (symbol->string name))
- (ver (elpa-version->string version))
- (url (package-source-url kind name ver repo)))
- (make-elpa-package name ver
- (ensure-list reqs) synopsis kind
- (package-home-page (first rest))
- auctex-readme-mock
- url)))
- (_ #f)))))
- (mock
- ((guix build download) url-fetch
- (lambda (url file . _)
- (call-with-output-file file
- (lambda (port)
- (display "fake tarball" port)))))
-
- (match (elpa->guix-package pkg)
- (('package
- ('name "emacs-auctex")
- ('version "11.88.6")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('string-append
- "https://elpa.gnu.org/packages/auctex-" 'version ".tar"))
- ('sha256 ('base32 (? string? hash)))))
- ('build-system 'emacs-build-system)
- ('home-page "http://www.gnu.org/software/auctex/")
- ('synopsis "Integrated environment for *TeX*")
- ('description (? string?))
- ('license 'license:gpl3+))
- #t)
- (x
- (pk 'fail x #f))))))
+ ;; Set up an HTTP server and use it as a pseudo-proxy so that
+ ;; 'elpa->guix-package' talks to it.
+ (with-http-server `((200 ,(object->string elpa-mock-archive))
+ (200 "This is the description.")
+ (200 "fake tarball contents"))
+ (parameterize ((current-http-proxy (%local-url)))
+ (match (elpa->guix-package pkg 'gnu/http)
+ (('package
+ ('name "emacs-auctex")
+ ('version "11.88.6")
+ ('source
+ ('origin
+ ('method 'url-fetch)
+ ('uri ('string-append
+ "http://elpa.gnu.org/packages/auctex-" 'version ".tar"))
+ ('sha256 ('base32 (? string? hash)))))
+ ('build-system 'emacs-build-system)
+ ('home-page "http://www.gnu.org/software/auctex/")
+ ('synopsis "Integrated environment for *TeX*")
+ ('description "This is the description.")
+ ('license 'license:gpl3+))
+ #t)
+ (x
+ (pk 'fail x #f))))))
(test-assert "elpa->guix-package test 1"
(eval-test-with-elpa "auctex"))
(test-end "elpa")
+
+;; Local Variables:
+;; eval: (put 'with-http-server 'scheme-indent-function 1)
+;; End:
diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh
index 2d4b3fac3f..4c37b61b38 100644
--- a/tests/guix-graph.sh
+++ b/tests/guix-graph.sh
@@ -1,5 +1,6 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
#
# This file is part of GNU Guix.
#
@@ -20,10 +21,29 @@
# Test the 'guix graph' command-line utility.
#
-tmpfile1="t-guix-graph1-$$"
-tmpfile2="t-guix-graph2-$$"
+module_dir="t-guix-graph-$$"
+mkdir "$module_dir"
+trap "rm -rf $module_dir" EXIT
+
+tmpfile1="$module_dir/t-guix-graph1-$$"
+tmpfile2="$module_dir/t-guix-graph2-$$"
trap 'rm -f "$tmpfile1" "$tmpfile2"' EXIT
+
+cat > "$module_dir/foo.scm"<<EOF
+(define-module (foo)
+ #:use-module (guix packages)
+ #:use-module (gnu packages base))
+
+(define-public dummy
+ (package (inherit hello)
+ (name "dummy")
+ (version "42")
+ (synopsis "dummy package")
+ (description "dummy package. Only used for testing purposes.")))
+EOF
+
+
guix graph --version
for package in guile-bootstrap coreutils python
@@ -59,3 +79,6 @@ guix graph git | grep 'label = "openssl'
guix graph git --with-input=openssl=libressl | grep 'label = "libressl'
if guix graph git --with-input=openssl=libressl | grep 'label = "openssl'
then false; else true; fi
+
+# Try --load-path
+guix graph -L $module_dir dummy | grep 'label = "dummy'
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 1b2c425725..3a831cba1d 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
#
@@ -120,7 +120,12 @@ EOF
if guix system build "$tmpfile" -n 2> "$errorfile"
then false
else
- if test "`guile -c '(display (effective-version))'`" = 2.2
+ if test "`guile -c '(display (effective-version))'`" = 3.0
+ then
+ # FIXME: With Guile 3.3.0 the error is reported on line 11.
+ # See <https://bugs.gnu.org/38388>.
+ grep "$tmpfile:[0-9]\+:[0-9]\+:.*GRUB-config.*[Uu]nbound variable" "$errorfile"
+ elif test "`guile -c '(display (effective-version))'`" = 2.2
then
# FIXME: With Guile 2.2.0 the error is reported on line 4.
# See <http://bugs.gnu.org/26107>.
@@ -130,6 +135,26 @@ else
fi
fi
+cat > "$tmpfile" <<EOF
+(use-modules (gnu)) ; 1
+
+(operating-system ; 3
+ (file-systems (cons (file-system ; 4
+ (device (file-system-label "root"))
+ (mount-point "/") ; 6
+ (type "ext4")))) ; 7 (!!)
+ %base-file-systems)
+EOF
+
+if guix system build "$tmpfile" -n 2> "$errorfile"
+then false
+else
+ # Here '%base-file-systems' appears as if it were a field specified of the
+ # enclosing 'operating-system' form due to parenthesis mismatch.
+ grep "$tmpfile:3:[0-9]\+:.*%base-file-system.*invalid field specifier" \
+ "$errorfile"
+fi
+
OS_BASE='
(host-name "antelope")
(timezone "Europe/Paris")
diff --git a/tests/lint.scm b/tests/lint.scm
index 3a9b539a24..4ce45b4a70 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@@ -756,14 +756,16 @@
(test-equal "cve: one vulnerability"
"probably vulnerable to CVE-2015-1234"
- (mock ((guix lint) package-vulnerabilities
+ (let ((dummy-vulnerabilities
(lambda (package)
- (list (make-struct/no-tail (@@ (guix cve) <vulnerability>)
- "CVE-2015-1234"
- (list (cons (package-name package)
- (package-version package)))))))
- (single-lint-warning-message
- (check-vulnerabilities (dummy-package "pi" (version "3.14"))))))
+ (list (make-struct/no-tail
+ (@@ (guix cve) <vulnerability>)
+ "CVE-2015-1234"
+ (list (cons (package-name package)
+ (package-version package))))))))
+ (single-lint-warning-message
+ (check-vulnerabilities (dummy-package "pi" (version "3.14"))
+ dummy-vulnerabilities))))
(test-equal "cve: one patched vulnerability"
'()
diff --git a/tests/lzlib.scm b/tests/lzlib.scm
index d8d0e6edf8..63d1e15641 100644
--- a/tests/lzlib.scm
+++ b/tests/lzlib.scm
@@ -87,8 +87,7 @@
(test-assert* "Bytevector of size relative to Lzip internal buffers (2 * dictionary)"
(compress-and-decompress
(random-bytevector
- (* 2 (car (car (assoc-ref (@@ (guix lzlib) %compression-levels)
- (@@ (guix lzlib) %default-compression-level))))))))
+ (* 2 (dictionary-size+match-length-limit %default-compression-level)))))
(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB)"
(compress-and-decompress (random-bytevector (* 64 1024))))
diff --git a/tests/opam.scm b/tests/opam.scm
index d3626fd010..68b5908e3f 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -85,36 +85,33 @@ url {
(with-output-to-file (string-append my-package "/opam")
(lambda _
(format #t "~a" test-opam-file))))
- (mock ((guix import opam) get-opam-repository
- (lambda _
- test-repo))
- (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)
- ('propagated-inputs
- ('quasiquote
- (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
- ('native-inputs
- ('quasiquote
- (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
- ("ocamlbuild" ('unquote 'ocamlbuild)))))
- ('home-page "https://example.org/")
- ('synopsis "Some example package")
- ('description "This package is just an example.")
- ('license #f))
- (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash))
- (x
- (pk 'fail x #f))))))
+ (match (opam->guix-package "foo" #:repository test-repo)
+ (('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)
+ ('propagated-inputs
+ ('quasiquote
+ (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+ ('native-inputs
+ ('quasiquote
+ (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+ ("ocamlbuild" ('unquote 'ocamlbuild)))))
+ ('home-page "https://example.org/")
+ ('synopsis "Some example package")
+ ('description "This package is just an example.")
+ ('license #f))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f)))))
;; Test the opam file parser
;; We fold over some test cases. Each case is a pair of the string to parse and the
@@ -123,7 +120,7 @@ url {
(fold (lambda (test acc)
(display test) (newline)
(and acc
- (let ((result (peg:tree (match-pattern (@@ (guix import opam) string-pat) (car test)))))
+ (let ((result (peg:tree (match-pattern string-pat (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
@@ -138,7 +135,7 @@ url {
(fold (lambda (test acc)
(display test) (newline)
(and acc
- (let ((result (peg:tree (match-pattern (@@ (guix import opam) multiline-string) (car test)))))
+ (let ((result (peg:tree (match-pattern multiline-string (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
@@ -150,7 +147,7 @@ url {
(test-assert "parse-lists"
(fold (lambda (test acc)
(and acc
- (let ((result (peg:tree (match-pattern (@@ (guix import opam) list-pat) (car test)))))
+ (let ((result (peg:tree (match-pattern list-pat (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
@@ -164,7 +161,7 @@ url {
(test-assert "parse-dicts"
(fold (lambda (test acc)
(and acc
- (let ((result (peg:tree (match-pattern (@@ (guix import opam) dict) (car test)))))
+ (let ((result (peg:tree (match-pattern dict (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
@@ -176,7 +173,7 @@ url {
(test-assert "parse-conditions"
(fold (lambda (test acc)
(and acc
- (let ((result (peg:tree (match-pattern (@@ (guix import opam) condition) (car test)))))
+ (let ((result (peg:tree (match-pattern condition (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
diff --git a/tests/packages.scm b/tests/packages.scm
index 423c5061aa..1ff35ec9c4 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -100,7 +100,8 @@
(let* ((old (dummy-package "foo" (version "1")))
(tx (mock ((gnu packages) find-best-packages-by-name
(const '()))
- ((@@ (guix scripts package) transaction-upgrade-entry)
+ (transaction-upgrade-entry
+ #f ;no store access needed
(manifest-entry
(inherit (package->manifest-entry old))
(item (string-append (%store-prefix) "/"
@@ -113,7 +114,8 @@
(new (dummy-package "foo" (version "2")))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list new)))
- ((@@ (guix scripts package) transaction-upgrade-entry)
+ (transaction-upgrade-entry
+ #f ;no store access needed
(manifest-entry
(inherit (package->manifest-entry old))
(item (string-append (%store-prefix) "/"
@@ -130,7 +132,8 @@
(dep (deprecated-package "foo" new))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list dep)))
- ((@@ (guix scripts package) transaction-upgrade-entry)
+ (transaction-upgrade-entry
+ #f ;no store access needed
(manifest-entry
(inherit (package->manifest-entry old))
(item (string-append (%store-prefix) "/"
diff --git a/tests/publish.scm b/tests/publish.scm
index 204cfb4974..e43310ef00 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -153,8 +153,7 @@ References: ~a~%"
(signature (base64-encode
(string->utf8
(canonical-sexp->string
- ((@@ (guix scripts publish) signed-string)
- unsigned-info))))))
+ (signed-string unsigned-info))))))
(format #f "~aSignature: 1;~a;~a~%"
unsigned-info (gethostname) signature))
(utf8->string
@@ -184,8 +183,7 @@ References: ~%"
(signature (base64-encode
(string->utf8
(canonical-sexp->string
- ((@@ (guix scripts publish) signed-string)
- unsigned-info))))))
+ (signed-string unsigned-info))))))
(format #f "~aSignature: 1;~a;~a~%"
unsigned-info (gethostname) signature))
diff --git a/tests/records.scm b/tests/records.scm
index 16b7a9c35e..2c55a61720 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -286,10 +286,11 @@
(lambda ()
(eval exp (test-module))
#f)
- (lambda (key proc message location form . args)
+ (lambda (key proc message location form subform . _)
(and (eq? proc 'foo)
(string-match "invalid field" message)
- (equal? form '(baz 1 2 3 4 5))
+ (equal? subform '(baz 1 2 3 4 5))
+ (equal? form '(foo (baz 1 2 3 4 5)))
;; Make sure the location is that of the field specifier.
;; See <http://bugs.gnu.org/23969>.
@@ -299,6 +300,33 @@
,@(alist-delete 'line loc)))
(pk 'actual-loc location)))))))
+(test-assert "define-record-type* & wrong field specifier, identifier"
+ (let ((exp '(begin
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar (default 42))
+ (baz foo-baz))
+
+ (foo
+ baz))) ;syntax error
+ (loc (current-source-location))) ;keep this alignment!
+ (catch 'syntax-error
+ (lambda ()
+ (eval exp (test-module))
+ #f)
+ (lambda (key proc message location form subform . _)
+ (and (eq? proc 'foo)
+ (string-match "invalid field" message)
+ (equal? subform 'baz)
+ (equal? form '(foo baz))
+
+ ;; Here the location is that of the parent form.
+ (lset= equal?
+ (pk 'expected-loc
+ `((line . ,(- (assq-ref loc 'line) 2))
+ ,@(alist-delete 'line loc)))
+ (pk 'actual-loc location)))))))
+
(test-assert "define-record-type* & missing initializers"
(catch 'syntax-error
(lambda ()
diff --git a/tests/texlive.scm b/tests/texlive.scm
index e28eda175c..f7e5515c4c 100644
--- a/tests/texlive.scm
+++ b/tests/texlive.scm
@@ -20,10 +20,12 @@
#:use-module (gnu packages tex)
#:use-module (guix import texlive)
#:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (srfi srfi-26)
+ #:use-module (web client)
#:use-module (ice-9 match))
(test-begin "texlive")
@@ -67,12 +69,14 @@
(keyval (@ (value "tests") (key "topic")))
"\n null\n")))
+;; Avoid collisions with other tests.
+(%http-server-port 10200)
+
(test-equal "fetch-sxml: returns SXML for valid XML"
sxml
- (mock ((guix http-client) http-fetch
- (lambda (url)
- xml))
- ((@@ (guix import texlive) fetch-sxml) "foo")))
+ (with-http-server `((200 ,xml))
+ (parameterize ((current-http-proxy (%local-url)))
+ (fetch-sxml "foo"))))
;; TODO:
(test-assert "sxml->package"
@@ -86,7 +90,7 @@
(with-output-to-file (string-append directory "/foo")
(lambda ()
(display "source")))))
- (let ((result ((@@ (guix import texlive) sxml->package) sxml)))
+ (let ((result (sxml->package sxml)))
(match result
(('package
('name "texlive-latex-foo")
generated by cgit v1.2.3 (git 2.25.4) at 2024-06-30 08:52:56 +0000