summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/gnu-maintenance.scm19
-rw-r--r--tests/go.scm139
-rw-r--r--tests/grafts.scm83
-rw-r--r--tests/ipfs.scm55
-rw-r--r--tests/publish.scm4
-rw-r--r--tests/substitute.scm4
6 files changed, 230 insertions, 74 deletions
diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm
index a3e48a0933..837b80063a 100644
--- a/tests/gnu-maintenance.scm
+++ b/tests/gnu-maintenance.scm
@@ -19,7 +19,8 @@
(define-module (test-gnu-maintenance)
#:use-module (guix gnu-maintenance)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-64))
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match))
(test-begin "gnu-maintenance")
@@ -30,7 +31,10 @@
("texmacs" "TeXmacs-1.0.7.9-src.tar.gz")
("icecat" "icecat-38.4.0-gnu1.tar.bz2")
("mit-scheme" "mit-scheme-9.2.tar.gz")
- ("mediainfo" "mediainfo_20.09.tar.xz")))
+ ("mediainfo" "mediainfo_20.09.tar.xz")
+ ("exiv2" "exiv2-0.27.3-Source.tar.gz")
+ ("mpg321" "mpg321_0.3.2.orig.tar.gz")
+ ("bvi" "bvi-1.4.1.src.tar.gz")))
(every (lambda (project+file)
(not (apply release-file? project+file)))
'(("guile" "guile-www-1.1.1.tar.gz")
@@ -39,4 +43,15 @@
("mit-scheme" "mit-scheme-9.2-doc-pdf.tar.gz")
("gnutls" "gnutls-3.2.18-w32.zip")))))
+(test-assert "tarball->version"
+ (let ((tarball->version (@@ (guix gnu-maintenance) tarball->version)))
+ (every (match-lambda
+ ((file version)
+ (equal? (tarball->version file) version)))
+ '(("coreutils-8.32.tar.gz" "8.32")
+ ("mediainfo_20.09.tar.xz" "20.09")
+ ("exiv2-0.27.3-Source.tar.gz" "0.27.3")
+ ("mpg321_0.3.2.orig.tar.gz" "0.3.2")
+ ("bvi-1.4.1.src.tar.gz" "1.4.1")))))
+
(test-end)
diff --git a/tests/go.scm b/tests/go.scm
index 6ab99f508a..e5780e68b0 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -19,7 +19,7 @@
;;; Summary
;; Tests for guix/import/go.scm
-(define-module (test-import-go)
+(define-module (tests-import-go)
#:use-module (guix base32)
#:use-module (guix build-system go)
#:use-module (guix import go)
@@ -147,7 +147,8 @@ require github.com/kr/pretty v0.2.1
("https://pkg.go.dev/github.com/go-check/check"
. ,pkg.go.dev)
("https://pkg.go.dev/github.com/go-check/check?tab=licenses"
- . ,pkg.go.dev-licence))))
+ . ,pkg.go.dev-licence)
+ ("https://proxy.golang.org/github.com/go-check/check/@v/list" . ""))))
(test-begin "go")
@@ -169,6 +170,12 @@ require github.com/kr/pretty v0.2.1
"daa7c04131f5"
(go-version->git-ref "v1.2.4-0.20191109021931-daa7c04131f5"))
+(test-assert "go-pseudo-version? multi-digit version number"
+ (go-pseudo-version? "v1.23.1-0.20200526195155-81db48ad09cc"))
+
+(test-assert "go-pseudo-version? semantic version with rc"
+ (go-pseudo-version? "v1.4.0-rc.4.0.20200313231945-b860323f09d0"))
+
;;; Unit tests for (guix import go)
(test-equal "go-path-escape"
@@ -180,46 +187,43 @@ require github.com/kr/pretty v0.2.1
(define (testing-parse-mod name expected input)
(define (inf? p1 p2)
(string<? (car p1) (car p2)))
- (let ((input-port (open-input-string input)))
- (test-equal name
- (sort expected inf?)
- (sort
- ( (@@ (guix import go) parse-go.mod)
- input-port)
- inf?))))
+ (test-equal name
+ (sort expected inf?)
+ (sort ((@@ (guix import go) parse-go.mod) input) inf?)))
(testing-parse-mod "parse-go.mod-simple"
- '(("good/thing" . "v1.4.5")
- ("new/thing/v2" . "v2.3.4")
- ("other/thing" . "v1.0.2"))
+ '(("good/thing" "v1.4.5")
+ ("new/thing/v2" "v2.3.4")
+ ("other/thing" "v1.0.2"))
fixture-go-mod-simple)
(testing-parse-mod "parse-go.mod-with-block"
- '(("A" . "v1")
- ("B" . "v1.0.0")
- ("C" . "v1.0.0")
- ("D" . "v1.2.3")
- ("E" . "dev"))
+ '(("A" "v1")
+ ("B" "v1.0.0")
+ ("C" "v1.0.0")
+ ("D" "v1.2.3")
+ ("E" "dev"))
fixture-go-mod-with-block)
-(testing-parse-mod "parse-go.mod-complete"
- '(("github.com/corp/arbitrary-repo" . "v0.0.2")
- ("quoted.example.com/abitrary/repo" . "v0.0.2")
- ("one.example.com/abitrary/repo" . "v1.1.111")
- ("hub.jazz.net/git/user/project/sub/directory" . "v1.1.19")
- ("hub.jazz.net/git/user/project" . "v1.1.18")
- ("launchpad.net/~user/project/branch/sub/directory" . "v1.1.17")
- ("launchpad.net/~user/project/branch" . "v1.1.16")
- ("launchpad.net/project/series/sub/directory" . "v1.1.15")
- ("launchpad.net/project/series" . "v1.1.14")
- ("launchpad.net/project" . "v1.1.13")
- ("bitbucket.org/user/project/sub/directory" . "v1.11.21")
- ("bitbucket.org/user/project" . "v1.11.20")
- ("k8s.io/kubernetes/subproject" . "v1.1.101")
- ("github.com/user/project/sub/directory" . "v1.1.12")
- ("github.com/user/project" . "v1.1.11")
- ("github.com/go-check/check" . "v0.0.0-20140225173054-eb6ee6f84d0a"))
- fixture-go-mod-complete)
+(testing-parse-mod
+ "parse-go.mod-complete"
+ '(("github.com/corp/arbitrary-repo" "v0.0.2")
+ ("quoted.example.com/abitrary/repo" "v0.0.2")
+ ("one.example.com/abitrary/repo" "v1.1.111")
+ ("hub.jazz.net/git/user/project/sub/directory" "v1.1.19")
+ ("hub.jazz.net/git/user/project" "v1.1.18")
+ ("launchpad.net/~user/project/branch/sub/directory" "v1.1.17")
+ ("launchpad.net/~user/project/branch" "v1.1.16")
+ ("launchpad.net/project/series/sub/directory" "v1.1.15")
+ ("launchpad.net/project/series" "v1.1.14")
+ ("launchpad.net/project" "v1.1.13")
+ ("bitbucket.org/user/project/sub/directory" "v1.11.21")
+ ("bitbucket.org/user/project" "v1.11.20")
+ ("k8s.io/kubernetes/subproject" "v1.1.101")
+ ("github.com/user/project/sub/directory" "v1.1.12")
+ ("github.com/user/project" "v1.1.11")
+ ("github.com/go-check/check" "v0.0.0-20140225173054-eb6ee6f84d0a"))
+ fixture-go-mod-complete)
;;; End-to-end tests for (guix import go)
(define (mock-http-fetch testcase)
@@ -249,44 +253,43 @@ require github.com/kr/pretty v0.2.1
(test-equal "go-module->guix-package"
'(package
- (name "go-github-com-go-check-check")
- (version "0.0.0-20201130134442-10cb98267c6c")
- (source
- (origin
- (method git-fetch)
- (uri (git-reference
- (url "https://github.com/go-check/check.git")
- (commit (go-version->git-ref version))))
- (file-name (git-file-name name version))
- (sha256
- (base32
- "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"))))
- (build-system go-build-system)
- (arguments
- (quote (#:import-path "github.com/go-check/check")))
- (inputs
- (quasiquote (("go-github-com-kr-pretty"
- (unquote go-github-com-kr-pretty)))))
- (home-page "https://github.com/go-check/check")
- (synopsis "Instructions")
- (description #f)
- (license license:bsd-2))
+ (name "go-github-com-go-check-check")
+ (version "0.0.0-20201130134442-10cb98267c6c")
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/go-check/check")
+ (commit (go-version->git-ref version))))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"))))
+ (build-system go-build-system)
+ (arguments
+ '(#:import-path "github.com/go-check/check"))
+ (propagated-inputs
+ `(("go-github-com-kr-pretty" ,go-github-com-kr-pretty)))
+ (home-page "https://github.com/go-check/check")
+ (synopsis "Instructions")
+ (description "Package check is a rich testing extension for Go's testing \
+package.")
+ (license license:bsd-2))
;; Replace network resources with sample data.
(call-with-temporary-directory
(lambda (checkout)
(mock ((web client) http-get
(mock-http-get fixtures-go-check-test))
- (mock ((guix http-client) http-fetch
- (mock-http-fetch fixtures-go-check-test))
- (mock ((guix git) update-cached-checkout
- (lambda* (url #:key ref)
- ;; Return an empty directory and its hash.
- (values checkout
- (nix-base32-string->bytevector
- "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
- #f)))
- (go-module->guix-package "github.com/go-check/check")))))))
+ (mock ((guix http-client) http-fetch
+ (mock-http-fetch fixtures-go-check-test))
+ (mock ((guix git) update-cached-checkout
+ (lambda* (url #:key ref)
+ ;; Return an empty directory and its hash.
+ (values checkout
+ (nix-base32-string->bytevector
+ "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
+ #f)))
+ (go-module->guix-package "github.com/go-check/check")))))))
(test-end "go")
-
diff --git a/tests/grafts.scm b/tests/grafts.scm
index a12c6a5911..7e1959e4a7 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -468,4 +469,86 @@
replacement
"/gnu/store")))))
+(define (insert-nuls char-size str)
+ (string-join (map string (string->list str))
+ (make-string (- char-size 1) #\nul)))
+
+(define (nuls-to-underscores s)
+ (string-replace-substring s "\0" "_"))
+
+(define (annotate-buffer-boundary s)
+ (string-append (string-take s buffer-size)
+ "|"
+ (string-drop s buffer-size)))
+
+(define (abbreviate-leading-fill s)
+ (let ((s* (string-trim s #\=)))
+ (format #f "[~a =s]~a"
+ (- (string-length s)
+ (string-length s*))
+ s*)))
+
+(define (prettify-for-display s)
+ (abbreviate-leading-fill
+ (annotate-buffer-boundary
+ (nuls-to-underscores s))))
+
+(define (two-sample-refs-with-gap char-size1 char-size2 gap offset
+ char1 name1 char2 name2)
+ (string-append
+ (make-string (- buffer-size offset) #\=)
+ (insert-nuls char-size1
+ (string-append "/gnu/store/" (make-string 32 char1) name1))
+ gap
+ (insert-nuls char-size2
+ (string-append "/gnu/store/" (make-string 32 char2) name2))
+ (list->string (map integer->char (iota 77 33)))))
+
+(define (sample-map-entry old-char new-char new-name)
+ (cons (make-string 32 old-char)
+ (string->utf8 (string-append (make-string 32 new-char)
+ new-name))))
+
+(define (test-two-refs-with-gap char-size1 char-size2 gap offset)
+ (test-equal
+ (format #f "test-two-refs-with-gap, char-sizes ~a ~a, gap ~s, offset ~a"
+ char-size1 char-size2 gap offset)
+ (prettify-for-display
+ (two-sample-refs-with-gap char-size1 char-size2 gap offset
+ #\6 "-BlahBlaH"
+ #\8"-SoMeTHiNG"))
+ (prettify-for-display
+ (let* ((content (two-sample-refs-with-gap char-size1 char-size2 gap offset
+ #\5 "-blahblah"
+ #\7 "-something"))
+ (replacement (alist->vhash
+ (list (sample-map-entry #\5 #\6 "-BlahBlaH")
+ (sample-map-entry #\7 #\8 "-SoMeTHiNG")))))
+ (call-with-output-string
+ (lambda (output)
+ ((@@ (guix build graft) replace-store-references)
+ (open-input-string content) output
+ replacement
+ "/gnu/store")))))))
+
+(for-each (lambda (char-size1)
+ (for-each (lambda (char-size2)
+ (for-each (lambda (gap)
+ (for-each (lambda (offset)
+ (test-two-refs-with-gap char-size1
+ char-size2
+ gap
+ offset))
+ ;; offsets to test
+ (map (lambda (i)
+ (+ i (* 40 char-size1)))
+ (iota 30))))
+ ;; gaps
+ '("" "-" " " "a")))
+ ;; char-size2 values to test
+ '(1 2)))
+ ;; char-size1 values to test
+ '(1 2 4))
+
+
(test-end)
diff --git a/tests/ipfs.scm b/tests/ipfs.scm
new file mode 100644
index 0000000000..3b662b22bd
--- /dev/null
+++ b/tests/ipfs.scm
@@ -0,0 +1,55 @@
+;;; 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-ipfs)
+ #:use-module (guix ipfs)
+ #:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module (guix tests)
+ #:use-module (web uri)
+ #:use-module (srfi srfi-64))
+
+;; Test the (guix ipfs) module.
+
+(define (ipfs-gateway-running?)
+ "Return true if the IPFS gateway is running at %IPFS-BASE-URL."
+ (let* ((uri (string->uri (%ipfs-base-url)))
+ (socket (socket AF_INET SOCK_STREAM 0)))
+ (define connected?
+ (catch 'system-error
+ (lambda ()
+ (format (current-error-port)
+ "probing IPFS gateway at localhost:~a...~%"
+ (uri-port uri))
+ (connect socket AF_INET INADDR_LOOPBACK (uri-port uri))
+ #t)
+ (const #f)))
+
+ (close-port socket)
+ connected?))
+
+(unless (ipfs-gateway-running?)
+ (test-skip 1))
+
+(test-assert "add-file-tree + restore-file-tree"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (let* ((source (dirname (search-path %load-path "guix/base32.scm")))
+ (target (string-append directory "/r"))
+ (content (pk 'content (add-file-tree source))))
+ (restore-file-tree (content-name content) target)
+ (file=? source target)))))
diff --git a/tests/publish.scm b/tests/publish.scm
index 52101876b5..3e67c435ac 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -452,8 +452,8 @@ References: ~%"
(wait-for-file cached)
;; Both the narinfo and nar should be world-readable.
- (= #o644 (stat:perms (lstat cached)))
- (= #o644 (stat:perms (lstat nar)))
+ (= #o444 (logand #o444 (stat:perms (lstat cached))))
+ (= #o444 (logand #o444 (stat:perms (lstat nar))))
(let* ((body (http-get-port url))
(compressed (http-get nar-url))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 697abc4684..21b513e1d8 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -198,7 +198,7 @@ a file for NARINFO."
;; Never use file descriptor 4, unlike what happens when invoked by the
;; daemon.
-(%error-to-file-descriptor-4? #f)
+(%reply-file-descriptor #f)
(test-equal "query narinfo without signature"
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-11 09:02:13 +0000