diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/import-utils.scm | 10 | ||||
| -rw-r--r-- | tests/pack.scm | 307 | ||||
| -rw-r--r-- | tests/services/vpn.scm | 85 | ||||
| -rw-r--r-- | tests/texlive.scm | 639 |
4 files changed, 866 insertions, 175 deletions
diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 1565dd610a..7b078eac05 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017, 2022 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2017, 2022, 2023 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> @@ -53,6 +53,14 @@ Differences are hard to spot, e.g. in CLOS vs. GOOPS.")) "This @@ is not Texinfo syntax. Neither is this %@@>%." (beautify-description "This @ is not Texinfo syntax. Neither is this %@>%.")) +(test-equal "beautify-description: wrap PascalCase words in @code" + "The term @code{DelayedMatrix} refers to a class." + (beautify-description "The term DelayedMatrix refers to a class.")) + +(test-equal "beautify-description: do not wrap acronyms in @code" + "The term API is not code, but @code{myAPI} might be." + (beautify-description "The term API is not code, but myAPI might be.")) + (test-equal "license->symbol" 'license:lgpl2.0 (license->symbol license:lgpl2.0)) diff --git a/tests/pack.scm b/tests/pack.scm index ce5a2f8a53..cf249f861b 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -76,66 +76,66 @@ (test-begin "pack") -(unless (network-reachable?) (test-skip 1)) -(test-assertm "self-contained-tarball" %store - (mlet* %store-monad - ((profile -> (profile - (content (packages->manifest (list %bootstrap-guile))) - (hooks '()) - (locales? #f))) - (tarball (self-contained-tarball "pack" profile - #:symlinks '(("/bin/Guile" - -> "bin/guile")) - #:compressor %gzip-compressor - #:archiver %tar-bootstrap)) - (check (gexp->derivation - "check-tarball" - (with-imported-modules '((guix build utils)) - #~(begin - (use-modules (guix build utils) - (srfi srfi-1)) - - (define store - ;; The unpacked store. - (string-append "." (%store-directory) "/")) - - (define (canonical? file) - ;; Return #t if FILE is read-only and its mtime is 1. - (let ((st (lstat file))) - (or (not (string-prefix? store file)) - (eq? 'symlink (stat:type st)) - (and (= 1 (stat:mtime st)) - (zero? (logand #o222 - (stat:mode st))))))) - - (define bin - (string-append "." #$profile "/bin")) - - (setenv "PATH" - (string-append #$%tar-bootstrap "/bin")) - (system* "tar" "xvf" #$tarball) - (mkdir #$output) - (exit - (and (file-exists? (string-append bin "/guile")) - (file-exists? store) - (every canonical? - (find-files "." (const #t) - #:directories? #t)) - (string=? (string-append #$%bootstrap-guile "/bin") - (readlink bin)) - (string=? (string-append ".." #$profile - "/bin/guile") - (readlink "bin/Guile"))))))))) - (built-derivations (list check)))) - ;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of ;; commit c45477d2a1a651485feede20fe0f3d15aec48b39 and related changes. Thus, ;; run it on the user's store, if it's available, on the grounds that these ;; dependencies may be already there, or we can get substitutes or build them ;; quite inexpensively; see <https://bugs.gnu.org/32184>. - (with-external-store store (unless store (test-skip 1)) + (test-assertm "self-contained-tarball" store + (mlet* %store-monad + ((guile (set-guile-for-build (default-guile))) + (profile -> (profile + (content (packages->manifest (list %bootstrap-guile))) + (hooks '()) + (locales? #f))) + (tarball (self-contained-tarball "pack" profile + #:symlinks '(("/bin/Guile" + -> "bin/guile")) + #:compressor %gzip-compressor + #:archiver %tar-bootstrap)) + (check (gexp->derivation + "check-tarball" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (srfi srfi-1)) + + (define store + ;; The unpacked store. + (string-append "." (%store-directory) "/")) + + (define (canonical? file) + ;; Return #t if FILE is read-only and its mtime is 1. + (let ((st (lstat file))) + (or (not (string-prefix? store file)) + (eq? 'symlink (stat:type st)) + (and (= 1 (stat:mtime st)) + (zero? (logand #o222 + (stat:mode st))))))) + + (define bin + (string-append "." #$profile "/bin")) + + (setenv "PATH" + (string-append #$%tar-bootstrap "/bin")) + (system* "tar" "xvf" #$tarball) + (mkdir #$output) + (exit + (and (file-exists? (string-append bin "/guile")) + (file-exists? store) + (every canonical? + (find-files "." (const #t) + #:directories? #t)) + (string=? (string-append #$%bootstrap-guile "/bin") + (readlink bin)) + (string=? (string-append ".." #$profile + "/bin/guile") + (readlink "bin/Guile"))))))))) + (built-derivations (list check)))) + + (unless store (test-skip 1)) (test-assertm "self-contained-tarball + localstatedir" store (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) @@ -239,15 +239,14 @@ ((layer) (invoke "tar" "xvf" layer))) - (when - (and (file-exists? (string-append bin "/guile")) - (file-exists? "var/guix/db/db.sqlite") - (file-is-directory? "tmp") - (string=? (string-append #$%bootstrap-guile "/bin") - (pk 'binlink (readlink bin))) - (string=? (string-append #$profile "/bin/guile") - (pk 'guilelink (readlink "bin/Guile")))) - (mkdir #$output))))))) + (when (and (file-exists? (string-append bin "/guile")) + (file-exists? "var/guix/db/db.sqlite") + (file-is-directory? "tmp") + (string=? (string-append #$%bootstrap-guile "/bin") + (pk 'binlink (readlink bin))) + (string=? (string-append #$profile "/bin/guile") + (pk 'guilelink (readlink "bin/Guile")))) + (mkdir #$output))))))) (built-derivations (list check)))) (unless store (test-skip 1)) @@ -310,71 +309,72 @@ (plain-file "postinst" "echo running configure script\n")))) (check - (gexp->derivation "check-deb-pack" - (with-imported-modules '((guix build utils)) - #~(begin - (use-modules (guix build utils) - (ice-9 match) - (ice-9 popen) - (ice-9 rdelim) - (ice-9 textual-ports) - (rnrs base)) - - (setenv "PATH" (string-join - (list (string-append #+%tar-bootstrap "/bin") - (string-append #+dpkg "/bin") - (string-append #+%ar-bootstrap "/bin")) - ":")) - - ;; Validate the output of 'dpkg --info'. - (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb)) - (info (get-string-all port)) - (exit-val (status:exit-val (close-pipe port)))) - (assert (zero? exit-val)) - - (assert (string-contains - info - (string-append "Package: " - #+(package-name %bootstrap-guile)))) - - (assert (string-contains - info - (string-append "Version: " - #+(package-version %bootstrap-guile))))) - - ;; Sanity check .deb contents. - (invoke "ar" "-xv" #$deb) - (assert (file-exists? "debian-binary")) - (assert (file-exists? "data.tar.gz")) - (assert (file-exists? "control.tar.gz")) - - ;; Verify there are no hard links in data.tar.gz, as hard - ;; links would cause dpkg to fail unpacking the archive. - (define hard-links - (let ((port (open-pipe* OPEN_READ "tar" "-tvf" "data.tar.gz"))) - (let loop ((hard-links '())) - (match (read-line port) - ((? eof-object?) - (assert (zero? (status:exit-val (close-pipe port)))) - hard-links) - (line - (if (string-prefix? "u" line) - (loop (cons line hard-links)) - (loop hard-links))))))) - - (unless (null? hard-links) - (error "hard links found in data.tar.gz" hard-links)) - - ;; Verify the presence of the control files. - (invoke "tar" "-xf" "control.tar.gz") - (assert (file-exists? "control")) - (assert (and (file-exists? "postinst") - (= #o111 ;script is executable - (logand #o111 (stat:perms - (stat "postinst")))))) - (assert (file-exists? "triggers")) - - (mkdir #$output)))))) + (gexp->derivation + "check-deb-pack" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (ice-9 textual-ports) + (rnrs base)) + + (setenv "PATH" (string-join + (list (string-append #+%tar-bootstrap "/bin") + (string-append #+dpkg "/bin") + (string-append #+%ar-bootstrap "/bin")) + ":")) + + ;; Validate the output of 'dpkg --info'. + (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb)) + (info (get-string-all port)) + (exit-val (status:exit-val (close-pipe port)))) + (assert (zero? exit-val)) + + (assert (string-contains + info + (string-append "Package: " + #+(package-name %bootstrap-guile)))) + + (assert (string-contains + info + (string-append "Version: " + #+(package-version %bootstrap-guile))))) + + ;; Sanity check .deb contents. + (invoke "ar" "-xv" #$deb) + (assert (file-exists? "debian-binary")) + (assert (file-exists? "data.tar.gz")) + (assert (file-exists? "control.tar.gz")) + + ;; Verify there are no hard links in data.tar.gz, as hard + ;; links would cause dpkg to fail unpacking the archive. + (define hard-links + (let ((port (open-pipe* OPEN_READ "tar" "-tvf" "data.tar.gz"))) + (let loop ((hard-links '())) + (match (read-line port) + ((? eof-object?) + (assert (zero? (status:exit-val (close-pipe port)))) + hard-links) + (line + (if (string-prefix? "u" line) + (loop (cons line hard-links)) + (loop hard-links))))))) + + (unless (null? hard-links) + (error "hard links found in data.tar.gz" hard-links)) + + ;; Verify the presence of the control files. + (invoke "tar" "-xf" "control.tar.gz") + (assert (file-exists? "control")) + (assert (and (file-exists? "postinst") + (= #o111 ;script is executable + (logand #o111 (stat:perms + (stat "postinst")))))) + (assert (file-exists? "triggers")) + + (mkdir #$output)))))) (built-derivations (list check)))) (unless store (test-skip 1)) @@ -390,32 +390,33 @@ #:symlinks '(("/bin/guile" -> "bin/guile")) #:extra-options '(#:relocatable? #t))) (check - (gexp->derivation "check-rpm-pack" - (with-imported-modules (source-module-closure - '((guix build utils))) - #~(begin - (use-modules (guix build utils)) - - (define fakeroot #+(file-append fakeroot "/bin/fakeroot")) - (define rpm #+(file-append rpm-for-tests "/bin/rpm")) - (mkdir-p "/tmp/lib/rpm") - - ;; Install the RPM package. This causes RPM to validate the - ;; signatures, header as well as the file digests, which - ;; makes it a rather thorough test. - (mkdir "test-prefix") - (invoke fakeroot rpm "--install" - (string-append "--prefix=" (getcwd) "/test-prefix") - #$rpm-pack) - - ;; Invoke the installed Guile command. - (invoke "./test-prefix/bin/guile" "--version") - - ;; Uninstall the RPM package. - (invoke fakeroot rpm "--erase" "guile-bootstrap") - - ;; Required so the above is run. - (mkdir #$output)))))) + (gexp->derivation + "check-rpm-pack" + (with-imported-modules (source-module-closure + '((guix build utils))) + #~(begin + (use-modules (guix build utils)) + + (define fakeroot #+(file-append fakeroot "/bin/fakeroot")) + (define rpm #+(file-append rpm-for-tests "/bin/rpm")) + (mkdir-p "/tmp/lib/rpm") + + ;; Install the RPM package. This causes RPM to validate the + ;; signatures, header as well as the file digests, which + ;; makes it a rather thorough test. + (mkdir "test-prefix") + (invoke fakeroot rpm "--install" + (string-append "--prefix=" (getcwd) "/test-prefix") + #$rpm-pack) + + ;; Invoke the installed Guile command. + (invoke "./test-prefix/bin/guile" "--version") + + ;; Uninstall the RPM package. + (invoke fakeroot rpm "--erase" "guile-bootstrap") + + ;; Required so the above is run. + (mkdir #$output)))))) (built-derivations (list check))))) (test-end) diff --git a/tests/services/vpn.scm b/tests/services/vpn.scm new file mode 100644 index 0000000000..1607d1bbfc --- /dev/null +++ b/tests/services/vpn.scm @@ -0,0 +1,85 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 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 vpn) + #:use-module (gnu packages vpn) + #:use-module (gnu services vpn) + #:use-module (guix gexp) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +;;; Commentary: +;;; +;;; Unit tests for the (gnu services vpn) module. +;;; +;;; Code: + +;;; Access some internals for whitebox testing. +(define ipv4-address? (@@ (gnu services vpn) ipv4-address?)) +(define ipv6-address? (@@ (gnu services vpn) ipv6-address?)) +(define host-name? (@@ (gnu services vpn) host-name?)) +(define endpoint-host-names + (@@ (gnu services vpn) endpoint-host-names)) + +(test-begin "vpn-services") + +(test-assert "ipv4-address?" + (every ipv4-address? + (list "192.95.5.67:1234" + "10.0.0.1"))) + +(test-assert "ipv6-address?" + (every ipv6-address? + (list "[2001:db8::c05f:543]:2468" + "2001:db8::c05f:543" + "2001:db8:855b:0000:0000:0567:5673:23b5" + "2001:db8:855b::0567:5673:23b5"))) + +(define %wireguard-peers + (list (wireguard-peer + (name "dummy1") + (public-key "VlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XjoalC8=") + (endpoint "some.dynamic-dns.service:53281") + (allowed-ips '())) + (wireguard-peer + (name "dummy2") + (public-key "AlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC9=") + (endpoint "example.org") + (allowed-ips '())) + (wireguard-peer + (name "dummy3") + (public-key "BlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC7=") + (endpoint "10.0.0.7:7777") + (allowed-ips '())) + (wireguard-peer + (name "dummy4") + (public-key "ClesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC6=") + (endpoint "[2345:0425:2CA1::0567:5673:23b5]:44444") + (allowed-ips '())))) + +(test-equal "endpoint-host-names" + ;; The first element of the pair the public Wireguard key associated to a + ;; host name. + '(("VlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XjoalC8=" . + "some.dynamic-dns.service:53281") + ("AlesLiEB5BFd//OD2ILKXviolfz+hodG6uZ+XgoalC9=" . + "example.org")) + (endpoint-host-names %wireguard-peers)) + +(test-end "vpn-services") diff --git a/tests/texlive.scm b/tests/texlive.scm index 7d7ad332b4..98461f7e51 100644 --- a/tests/texlive.scm +++ b/tests/texlive.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2022 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2023 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,7 +32,155 @@ (test-begin "texlive") (define %fake-tlpdb - '(("stricttex" + '(("12many" + . ((name + . "12many") + (catalogue + . "one2many") + (shortdesc + . "Generalising mathematical index sets") + (longdesc + . "In the discrete branches of mathematics...") + (docfiles + . ("texmf-dist/doc/latex/12many/12many.pdf" + "texmf-dist/doc/latex/12many/README")) + (srcfiles + . ("texmf-dist/source/latex/12many/12many.dtx" + "texmf-dist/source/latex/12many/12many.ins")) + (runfiles + . ("texmf-dist/tex/latex/12many/12many.sty")) + (catalogue-license . "lppl"))) + ("adforn" + (name . "adforn") + (shortdesc . "OrnementsADF font with TeX/LaTeX support") + (longdesc . "The bundle provides the Ornements ADF font...") + (execute "addMap OrnementsADF.map") + (docfiles + "texmf-dist/doc/fonts/adforn/COPYING" + "texmf-dist/doc/fonts/adforn/NOTICE" + "texmf-dist/doc/fonts/adforn/README" + "texmf-dist/doc/fonts/adforn/adforn.pdf") + (runfiles + "texmf-dist/fonts/afm/arkandis/adforn/OrnementsADF.afm" + "texmf-dist/fonts/enc/dvips/adforn/OrnementsADF.enc" + "texmf-dist/fonts/map/dvips/adforn/OrnementsADF.map" + "texmf-dist/fonts/tfm/arkandis/adforn/OrnementsADF.tfm" + "texmf-dist/fonts/type1/arkandis/adforn/OrnementsADF.pfb" + "texmf-dist/tex/latex/adforn/adforn.sty" + "texmf-dist/tex/latex/adforn/uornementsadf.fd") + (catalogue-license . "lppl gpl2")) + ("authorindex" + (name . "authorindex") + (shortdesc . "Index citations by author names") + (longdesc . "This package allows the user to...") + (depend "authorindex.ARCH") + (docfiles "texmf-dist/doc/latex/authorindex/COPYING") + (runfiles + "texmf-dist/scripts/authorindex/authorindex" + "texmf-dist/tex/latex/authorindex/authorindex.sty") + (catalogue-license . "lppl")) + ("authorindex.x86_64-linux" + (name . "authorindex.x86_64-linux") + (binfiles "bin/amd64-netbsd/authorindex")) + ("chs-physics-report" + . ((name . "ch-physics-report") + (shortdesc . "Physics lab reports...") + (longdesc . "This package may...") + (docfiles + . + ("texmf-dist/doc/latex/chs-physics-report/README.txt" + "texmf-dist/doc/latex/chs-physics-report/chs-physics-report.pdf")) + (runfiles + . + ("texmf-dist/tex/latex/chs-physics-report/chs-physics-report.sty")) + (catalogue-license . "pd cc-by-sa-3"))) + ("collection-basic" + (name . "collection-basic") + (shortdesc . "Essential programs and files") + (longdesc . "These files are regarded as basic...") + (depend "amsfonts" "hyph-utf8" "hyphen-base" "texlive-common" + "texlive.infra" "tlshell")) + ("collection-texworks" + (name . "collection-texworks") + (shortdesc . "TeXworks editor...") + (longdesc . "See http...") + (depend "texworks" "collection-basic")) + ("cyrillic-bin" + (name . "cyrillic-bin") + (shortdesc . "Cyrillic bibtex and makeindex") + (depend "cyrillic-bin.ARCH") + (docfiles + "texmf-dist/doc/man/man1/rubibtex.1" + "texmf-dist/doc/man/man1/rubibtex.man1.pdf") + (runfiles + "texmf-dist/scripts/texlive-extra/rumakeindex.sh" + "texmf-dist/scripts/texlive-extra/rubibtex.sh")) + ("cyrillic-bin.x86_64-linux" + (name . "cyrillic-bin.x86_64-linux") + (shortdesc . "x86_64-linux files of cyrillic-bin") + (binfiles + "bin/x86_64-linux/rubibtex" + "bin/x86_64-linux/rumakeindex")) + ("example" + . ((name . "example") + (shortdesc . "Typeset examples...") + (longdesc . "The package makes it easier...") + (runfiles + . + ("texmf-dist/tex/latex/example/example.sty")) + (catalogue-license . "gpl"))) + ("lollipop" + (name . "lollipop") + (shortdesc . "TeX made easy") + (longdesc . "Lollipop is TeX made easy...") + (execute "AddFormat name=lollipop engine=tex options=\"lollipop.ini\"...") + (docfiles + "texmf-dist/doc/otherformats/lollipop/README" + "texmf-dist/doc/otherformats/lollipop/manual/address.tex" + "texmf-dist/doc/otherformats/lollipop/manual/appendix.tex" + "texmf-dist/doc/otherformats/lollipop/manual/btxmac.tex" + "texmf-dist/doc/otherformats/lollipop/manual/comm.tex" + "texmf-dist/doc/otherformats/lollipop/manual/comment.tex" + "texmf-dist/doc/otherformats/lollipop/manual/example.tex" + "texmf-dist/doc/otherformats/lollipop/manual/extern.tex" + "texmf-dist/doc/otherformats/lollipop/manual/head.tex" + "texmf-dist/doc/otherformats/lollipop/manual/list.tex" + "texmf-dist/doc/otherformats/lollipop/manual/lollipop-manual.bib" + "texmf-dist/doc/otherformats/lollipop/manual/lollipop-manual.pdf") + (runfiles + "texmf-dist/tex/lollipop/lollipop-define.tex" + "texmf-dist/tex/lollipop/lollipop-document.tex" + "texmf-dist/tex/lollipop/lollipop-float.tex" + "texmf-dist/tex/lollipop/lollipop-fontdefs.tex" + "texmf-dist/tex/lollipop/lollipop-fonts.tex" + "texmf-dist/tex/lollipop/lollipop-heading.tex" + "texmf-dist/tex/lollipop/lollipop-lists.tex" + "texmf-dist/tex/lollipop/lollipop-output.tex" + "texmf-dist/tex/lollipop/lollipop-plain.tex" + "texmf-dist/tex/lollipop/lollipop-text.tex" + "texmf-dist/tex/lollipop/lollipop-tools.tex" + "texmf-dist/tex/lollipop/lollipop.ini" + "texmf-dist/tex/lollipop/lollipop.tex") + (catalogue-license . "gpl3")) + ("pax" + (name . "pax") + (shortdesc . "Extract and reinsert PDF...") + (longdesc . "If PDF files are...") + (depend "pax.ARCH") + (docfiles + "texmf-dist/doc/latex/pax/README") + (srcfiles + "texmf-dist/source/latex/pax/Makefile" + "texmf-dist/source/latex/pax/build.xml") + (runfiles + "texmf-dist/scripts/pax/pdfannotextractor.pl") + (catalogue-license . "lppl gpl")) + ("pax.x86_64-linux" + (name . "pax.x86_64-linux") + (shortdesc . "x86_64-linux files of pax") + (binfiles + "bin/x86_64-linux/pdfannotextractor")) + ("stricttex" . ((name . "stricttex") (shortdesc @@ -50,6 +199,13 @@ stuff like \\newcommand\\pi'12{\\pi '_{12}}.") . ("texmf-dist/tex/lualatex/stricttex/stricttex.lua" "texmf-dist/tex/lualatex/stricttex/stricttex.sty")) (catalogue-license . "lppl1.3c"))) + ("tex" + (name . "tex") + (shortdesc . "A sophisticated typesetting engine") + (longdesc . "TeX is a typesetting system that incorporates...") + (depend "cm" "hyphen-base" "tex.ARCH") + (docfiles "texmf-dist/doc/man/man1/tex.1") + (catalogue-license . "knuth")) ("texsis" . ((name . "texsis") @@ -69,7 +225,7 @@ theorems and proofs, centered or non-justified text, and listing computer code; Specialized macros for easily constructing ruled tables. TeXsis was originally developed for physicists, but others may also find it useful. It is completely compatible with Plain TeX.") - (depend . ("cm" "hyphen-base" "knuth-lib" "plain" "tex")) + (depend . ("tex" "plain" "knuth-lib" "hyphen-base" "cm")) (docfiles . ("texmf-dist/doc/man/man1/texsis.1" "texmf-dist/doc/man/man1/texsis.man1.pdf" @@ -156,7 +312,58 @@ completely compatible with Plain TeX.") "texmf-dist/tex/texsis/base/thesis.txs" "texmf-dist/tex/texsis/base/twin.txs" "texmf-dist/tex/texsis/config/texsis.ini")) - (catalogue-license . "lppl"))))) + (catalogue-license . "lppl"))) + ("trsym" + (name . "trsym") + (shortdesc . "Symbols for transformations") + (longdesc . "The bundle provides Metafont...") + (docfiles "texmf-dist/doc/latex/trsym/README" + "texmf-dist/doc/latex/trsym/manifest.txt" + "texmf-dist/doc/latex/trsym/trsym.pdf") + (srcfiles "texmf-dist/source/latex/trsym/trsym.dtx" + "texmf-dist/source/latex/trsym/trsym.ins") + (runfiles "texmf-dist/fonts/source/public/trsym/trsy.mf" + "texmf-dist/fonts/source/public/trsym/trsy10.mf" + "texmf-dist/fonts/source/public/trsym/trsy12.mf" + "texmf-dist/fonts/tfm/public/trsym/trsy10.tfm" + "texmf-dist/fonts/tfm/public/trsym/trsy12.tfm" + "texmf-dist/tex/latex/trsym/trsym.sty" + "texmf-dist/tex/latex/trsym/utrsy.fd") + (catalogue-license . "lppl")))) + +(test-assert "texlive->guix-package, no docfiles" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "example" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-example") + ('version _) + ('source ('texlive-origin + 'name 'version + ('list "tex/latex/example/") + ('base32 (? string? hash)))) + ('build-system 'texlive-build-system) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) (test-assert "texlive->guix-package" ;; Replace network resources with sample data. @@ -174,27 +381,417 @@ completely compatible with Plain TeX.") #:package-database (lambda _ %fake-tlpdb)))) (match result - (`(package - (inherit (simple-texlive-package - "texlive-texsis" - (list "bibtex/bst/texsis/" - "doc/man/man1/" + (('package + ('name "texlive-texsis") + ('version _) + ('source ('texlive-origin + 'name 'version + ('list "bibtex/bst/texsis/" + "doc/man/man1/texsis.1" + "doc/man/man1/texsis.man1.pdf" "doc/otherformats/texsis/base/" "tex/texsis/base/" "tex/texsis/config/") - (base32 ,(? string? hash)) - #:trivial? #t)) - (version ,_) - (propagated-inputs - (list texlive-cm - texlive-hyphen-base - texlive-knuth-lib - texlive-plain - texlive-tex)) - (home-page ,(? string?)) - (synopsis ,(? string?)) - (description ,(? string?)) - (license lppl)) + ('base32 (? string? hash)))) + ('outputs ''("out" "doc")) + ('build-system 'texlive-build-system) + ('propagated-inputs + ('list 'texlive-cm + 'texlive-hyphen-base + 'texlive-knuth-lib + 'texlive-plain + 'texlive-tex)) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license 'lppl)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, with METAFONT files" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "trsym" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name _) + ('version _) + ('source _) + ('outputs _) + ('build-system _) + ('native-inputs + ('list 'texlive-metafont)) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, with catalogue entry, no inputs" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "12many" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-12many") + ('version _) + ('source ('texlive-origin + 'name 'version + ('list "doc/latex/12many/" + "source/latex/12many/" + "tex/latex/12many/") + ('base32 (? string? hash)))) + ('outputs ''("out" "doc")) + ('build-system 'texlive-build-system) + ('home-page "https://ctan.org/pkg/one2many") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'lppl)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, multiple licenses" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "chs-physics-report" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-chs-physics-report") + ('version _) + ('source ('texlive-origin + 'name 'version + ('list "doc/latex/chs-physics-report/" + "tex/latex/chs-physics-report/") + ('base32 (? string? hash)))) + ('outputs ''("out" "doc")) + ('build-system 'texlive-build-system) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license ('list 'public-domain 'cc-by-sa3.0))) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, meta-package" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "collection-texworks" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-collection-texworks") + ('version _) + ('source #f) + ('build-system 'trivial-build-system) + ('arguments + ('list '#:builder ('gexp ('mkdir ('ungexp 'output))))) + ('propagated-inputs + ('list 'texlive-collection-basic 'texlive-texworks)) + ('home-page "https://www.tug.org/texlive/") + ('synopsis (? string?)) + ('description (? string?)) + ('license + ('license:fsf-free "https://www.tug.org/texlive/copying.html"))) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, with TeX format" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "lollipop" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-lollipop") + ('version _) + ('source ('texlive-origin + 'name 'version + ('list "doc/otherformats/lollipop/" + "tex/lollipop/") + ('base32 (? string? hash)))) + ('outputs ''("out" "doc")) + ('build-system 'texlive-build-system) + ('arguments ('list '#:create-formats ('gexp ('list "lollipop")))) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license 'gpl3)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, execute but no TeX format" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "adforn" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-adforn") + ('version _) + ('source _) + ('outputs ''("out" "doc")) + ('build-system 'texlive-build-system) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, translate dependencies" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "collection-basic" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-collection-basic") + ('version _) + ('source _) + ('build-system 'trivial-build-system) + ('arguments + ('list '#:builder ('gexp ('mkdir ('ungexp 'output))))) + ('propagated-inputs + ('list 'texlive-amsfonts 'texlive-hyphen-complete)) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, lonely `hyphen-base' dependency and ARCH" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "tex" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-tex") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('arguments ('list '#:texlive-latex-bin? #f)) + ('propagated-inputs + ('list 'texlive-cm 'texlive-hyphen-base)) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, single script, no extension" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "authorindex" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-authorindex") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('arguments + ('list '#:link-scripts ('gexp ('list "authorindex")))) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, multiple scripts, with extensions" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "cyrillic-bin" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-cyrillic-bin") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('arguments + ('list '#:link-scripts + ('gexp ('list "rubibtex.sh" "rumakeindex.sh")))) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, script with associated input" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "pax" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-pax") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('arguments + ('list '#:link-scripts ('gexp ('list "pdfannotextractor.pl")))) + ('inputs + ('list 'perl)) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) #true) (_ (begin |