From b4ce7359fbc74eeacc4c8e1c209b913a3ee3870b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 1 Jun 2024 00:55:01 +0200 Subject: guix: import texlive: Propagate binaries when necessary. * guix/import/texlive.scm (no-bin-propagation-packages): New variable. (list-binfiles): New function. (linked-scripts): Renamed to... (list-linked-scripts): ... this. Now always return a list. (tlpdb->package): Handle binary propagation. * tests/texlive.scm (%fake-tlpdb): Add data for new tests. ("texlive->guix-package, propagated binaries, no script"): ("texlive->guix-package, propagated binaries and scripts"): ("texlive->guix-package, with skipped propagated binaries"): New tests. Change-Id: I707ba33a10aa98ad27151724d3ecc4158db6b7cc --- guix/import/texlive.scm | 95 ++++++++++++++++++++++++----------- tests/texlive.scm | 130 +++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 193 insertions(+), 32 deletions(-) diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index 7e79c77884..20dedc9114 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -64,6 +64,23 @@ "tex/generic/hyphen/" "web2c/")) +;; The following packages should propagate their binaries according to the TeX +;; Live database, but won't because said binaries are already provided by +;; "texlive-bin". As a consequence, the importer does not make them propagate +;; their "-bin" counterpart. +(define no-bin-propagation-packages + (list "cweb" + "latex-bin" + "luahbtex" + "luatex" + "metafont" + "pdftex" + "pdftosrc" + "synctex" + "tex" + "tie" + "web")) + (define string->license (match-lambda ("artistic2" 'artistic2.0) @@ -296,33 +313,39 @@ When TEXLIVE-ONLY is true, only TeX Live packages are returned." ;; Get the right (alphabetic) order. (reverse actions)))))) -(define (linked-scripts name package-database) +(define (list-binfiles name package-database) + "Return the list of \"binfiles\", i.e., files meant to be installed in +\"bin/\" directory, for package NAME according to PACKAGE-DATABASE." + (or (and-let* ((data (assoc-ref package-database name)) + (depend (assoc-ref data 'depend)) + ((member (string-append name ".ARCH") depend)) + (bin-data (assoc-ref package-database + ;; Any *nix-like architecture will do. + (string-append name ".x86_64-linux")))) + (map basename (assoc-ref bin-data 'binfiles))) + '())) + +(define (list-linked-scripts name package-database) "Return a list of script names to symlink from \"bin/\" directory for package NAME according to PACKAGE-DATABASE. Consider as scripts files with \".lua\", \".pl\", \".py\", \".rb\", \".sh\", \".tcl\", \".texlua\", \".tlu\" extensions, and files without extension." - (and-let* ((data (assoc-ref package-database name)) - ;; Check if binaries are associated to the package. - (depend (assoc-ref data 'depend)) - ((member (string-append name ".ARCH") depend)) - ;; List those binaries. - (bin-data (assoc-ref package-database - ;; Any *nix-like architecture will do. - (string-append name ".x86_64-linux"))) - (binaries (map basename (assoc-ref bin-data 'binfiles))) - ;; List scripts candidates. Bail out if there are none. - (runfiles (assoc-ref data 'runfiles)) - (scripts (filter (cut string-prefix? "texmf-dist/scripts/" <>) - runfiles)) - ((pair? scripts))) - (filter-map (lambda (script) - (and (any (lambda (ext) - (member (basename script ext) binaries)) - '(".lua" ".pl" ".py" ".rb" ".sh" ".tcl" ".texlua" - ".tlu")) - (basename script))) - ;; Get the right (alphabetic) order. - (reverse scripts)))) + (or (and-let* ((data (assoc-ref package-database name)) + ;; List scripts candidates. Bail out if there are none. + (runfiles (assoc-ref data 'runfiles)) + (scripts (filter (cut string-prefix? "texmf-dist/scripts/" <>) + runfiles)) + ((pair? scripts)) + (binfiles (list-binfiles name package-database))) + (filter-map (lambda (script) + (and (any (lambda (ext) + (member (basename script ext) binfiles)) + '(".lua" ".pl" ".py" ".rb" ".sh" ".tcl" ".texlua" + ".tlu")) + (basename script))) + ;; Get the right (alphabetic) order. + (reverse scripts))) + '())) (define* (files-differ? directory package-name #:key @@ -408,7 +431,20 @@ of those files are returned that are unexpectedly installed." (source (with-store store (download-multi-svn-to-store store ref (string-append name "-svn-multi-checkout"))))) - (let* ((scripts (linked-scripts texlive-name package-database)) + (let* ((scripts (list-linked-scripts texlive-name package-database)) + (propagated-inputs + (let ((binfiles (list-binfiles texlive-name package-database))) + (sort (append + ;; Check if propagation of binaries is necessary. It + ;; happens when binfiles outnumber the scripts, if any. + (if (and (> (length binfiles) (length scripts)) + (not (member texlive-name + no-bin-propagation-packages))) + (list (string-append name "-bin")) + '()) + ;; Regular dependencies, as specified in database. + (map guix-name (translate-depends depends))) + stringsymbol propagated-inputs) (() '()) - (inputs - `((propagated-inputs - (list ,@(map (compose string->symbol guix-name) - (sort inputs string string->license) (else #f)))) + ;; List of pure TeX Live dependencies for recursive calls. (translate-depends depends #t))))) (define texlive->guix-package diff --git a/tests/texlive.scm b/tests/texlive.scm index fac9faf714..bfd3f57f20 100644 --- a/tests/texlive.scm +++ b/tests/texlive.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2022 Ricardo Wurmus -;;; Copyright © 2023 Nicolas Goaziou +;;; Copyright © 2023, 2024 Nicolas Goaziou ;;; ;;; This file is part of GNU Guix. ;;; @@ -162,6 +162,16 @@ "texmf-dist/tex/lollipop/lollipop.ini" "texmf-dist/tex/lollipop/lollipop.tex") (catalogue-license . "gpl3")) + ("m-tx" + (name . "m-tx") + (shortdesc . "A preprocessor for pmx") + (longdesc . "M-Tx is a preprocessor to pmx") + (depend "m-tx.ARCH") + (runfiles "texmf-dist/scripts/m-tx/m-tx.lua")) + ("m-tx.x86_64-linux" + (name . "m-tx.x86_64-linux") + (binfiles "bin/x86_64-linux/m-tx" + "bin/x86_64-linux/prepmx")) ("pax" (name . "pax") (shortdesc . "Extract and reinsert PDF...") @@ -329,7 +339,22 @@ completely compatible with Plain TeX.") "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")))) + (catalogue-license . "lppl")) + ("vlna" + (name . "vlna") + (shortdesc . "Add ~ after non-syllabic preposition") + (longdesc . "Preprocessor for TeX source") + (depend "vlna.ARCH") + (docfiles "texmf-dist/doc/man/man1/vlna.1")) + ("vlna.x86_64-linux" + (shortdesc "x86_64-linux files of vlna") + (binfiles "bin/x86_64-linux/vlna")) + ("web" + (depend "web.ARCH") + (docfiles "texmf-dist/doc/man/man1/tangle.1")) + ("web.x86_64-linux" + (name . "web.x86_64-linux") + (binfiles "bin/x86_64-linux/tangle")))) (test-assert "texlive->guix-package, no docfiles" ;; Replace network resources with sample data. @@ -798,4 +823,105 @@ completely compatible with Plain TeX.") (format #t "~s~%" result) (pk 'fail result #f))))))) +(test-assert "texlive->guix-package, propagated binaries, no script" + ;; 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 "vlna" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-vlna") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('propagated-inputs + ('list 'texlive-vlna-bin)) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, propagated binaries and scripts" + ;; 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 "m-tx" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-m-tx") + ('version _) + ('source _) + ('build-system 'texlive-build-system) + ('arguments + ('list '#:link-scripts ('gexp ('list "m-tx.lua")))) + ('propagated-inputs + ('list 'texlive-m-tx-bin)) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, with skipped propagated binaries" + ;; 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 "web" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-web") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + (test-end "texlive") -- cgit v1.2.3