From 7f792d2acc0d3eeb95c6f8e0acd72ae304cec9be Mon Sep 17 00:00:00 2001 Message-Id: <7f792d2acc0d3eeb95c6f8e0acd72ae304cec9be.1692813549.git.mirai@makinata.eu> From: Jonathan Wakely Date: Wed, 27 Feb 2019 11:25:44 +0000 Subject: [PATCH] PR libstdc++/89466 avoid slow xsltproc command in configure Note: Backported from a4395a846a9343960714568e7cf8af4425e63a50. Certain broken versions of xsltproc ignore the --nonet option and will attempt to fetch the docbook stylesheet from the WWW when it isn't in the local XML catalog. This patch checks for the local stylesheet directory first, and doesn't use xsltproc if no local stylesheets are found. Checking for the local directory is done using xmlcatalog if available, only checking the hardcoded list of directories if xmlcatalog fails. The right directory for Suse is added to the hardcoded list. This should avoid doing an xsltproc check that would need to download the stylesheet, so no network connection is made even if a broken xsltproc is present. PR libstdc++/89466 * acinclude.m4 (GLIBCXX_CONFIGURE_DOCBOOK): Reorder check for local stylesheet directories before check for xsltproc. Try to use xmlcatalog to find local stylesheet directory before trying hardcoded paths. Add path used by suse to hardcoded paths. Adjust xsltproc check to look for the same stylesheet as doc/Makefile.am uses. Don't use xsltproc if xmlcatalog fails to find a local stylesheet. * configure.ac: Check for xmlcatalog. * Makefile.in: Regenerate. * configure: Likewise. * doc/Makefile.in: Likewise. * include/Makefile.in: Likewise. * libsupc++/Makefile.in: Likewise. * po/Makefile.in: Likewise. * python/Makefile.in: Likewise. * src/Makefile.in: Likewise. * src/c++11/Makefile.in: Likewise. * src/c++98/Makefile.in: Likewise. * src/filesystem/Makefile.in: Likewise. * testsuite/Makefile.in: Likewise. From-SVN: r269249 M;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be> ;;; ;;; 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-gexp) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix gexp) #:use-module ((guix grafts) #:select (%graft-with-utf8-locale?)) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix build-system trivial) #:use-module (guix tests) #:use-module ((guix build utils) #:select (with-directory-excursion)) #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module ((guix ui) #:select (load*)) #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages bootstrap) #:use-module ((guix diagnostics) #:select (guix-warning-port)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 popen) #:use-module (ice-9 ftw)) ;; Test the (guix gexp) module. (define %store (open-connection-for-tests)) (define (bootstrap-guile-effective-version) ;; TODO The package version of %bootstrap-guile is incorrect for ;; riscv64-linux (if (string=? "riscv64-linux" (%current-system)) "3.0" (package-version %bootstrap-guile))) ;; Globally disable grafts because they can trigger early builds. (%graft? #f) ;; When grafting, do not add dependency on 'glibc-utf8-locales'. (%graft-with-utf8-locale? #f) ;; For white-box testing. (define (gexp-inputs x) ((@@ (guix gexp) gexp-inputs) x)) (define (gexp-outputs x) ((@@ (guix gexp) gexp-outputs) x)) (define (gexp->sexp . x) (apply (@@ (guix gexp) gexp->sexp) x)) (define* (gexp->sexp* exp #:optional target) (run-with-store %store (gexp->sexp exp (%current-system) target) #:guile-for-build (%guile-for-build))) (define (gexp-input->tuple input) (list (gexp-input-thing input) (gexp-input-output input) (gexp-input-native? input))) (define %extension-package ;; Example of a package to use when testing 'with-extensions'. (dummy-package "extension" (build-system trivial-build-system) (arguments `(#:guile ,%bootstrap-guile #:modules ((guix build utils)) #:builder (begin (use-modules (guix build utils)) (let* ((out (string-append (assoc-ref %outputs "out") "/share/guile/site/" (effective-version)))) (mkdir-p out) (call-with-output-file (string-append out "/hg2g.scm") (lambda (port) (define defmod 'define-module) ;fool Geiser (write `(,defmod (hg2g) #:export (the-answer)) port) (write '(define the-answer 42) port))))))))) (test-begin "gexp") (test-equal "no references" '(display "hello gexp->approximate-sexp!") (gexp->approximate-sexp #~(display "hello gexp->approximate-sexp!"))) (test-equal "unquoted gexp" '(display "hello") (let ((inside #~"hello")) (gexp->approximate-sexp #~(display #$inside)))) (test-equal "unquoted gexp (native)" '(display "hello") (let ((inside #~"hello")) (gexp->approximate-sexp #~(display #+inside)))) (test-equal "spliced gexp" '(display '(fresh vegetables)) (let ((inside #~(fresh vegetables))) (gexp->approximate-sexp #~(display '(#$@inside))))) (test-equal "unspliced gexp, approximated" ;; (*approximate*) is really an implementation detail '(display '(*approximate*)) (let ((inside (file-append coreutils "/bin/hello"))) (gexp->approximate-sexp #~(display '(#$@inside))))) (test-equal "unquoted gexp, approximated" '(display '(*approximate*)) (let ((inside (file-append coreutils "/bin/hello"))) (gexp->approximate-sexp #~(display '#$inside)))) ;; See <https://issues.guix.gnu.org/54236>. (test-equal "unquoted sexp (not a gexp!)" '(list #(foo) (foo) () "foo" foo #xf00) (let ((inside/vector #(foo)) (inside/list '(foo)) (inside/empty '()) (inside/string "foo") (inside/symbol 'foo) (inside/number #xf00)) (gexp->approximate-sexp #~(list #$inside/vector #$inside/list #$inside/empty #$inside/string #$inside/symbol #$inside/number)))) (test-equal "no refs" '(display "hello!") (let ((exp (gexp (display "hello!")))) (and (gexp? exp) (null? (gexp-inputs exp)) (gexp->sexp* exp)))) (test-equal "sexp->gexp" '(a b (c d) e) (let ((exp (sexp->gexp '(a b (c d) e)))) (and (gexp? exp) (null? (gexp-inputs exp)) (gexp->sexp* exp)))) (test-equal "gexp->approximate-sexp, outputs" '(list 'out:foo (*approximate*) 'out:bar (*approximate*)) (gexp->approximate-sexp #~(list 'out:foo #$output:foo 'out:bar #$output:bar))) (test-equal "unquote" '(display `(foo ,(+ 2 3))) (let ((exp (gexp (display `(foo ,(+ 2 3)))))) (and (gexp? exp) (null? (gexp-inputs exp)) (gexp->sexp* exp)))) (test-assert "one input package" (let ((exp (gexp (display (ungexp coreutils))))) (and (gexp? exp) (match (gexp-inputs exp) ((input) (eq? (gexp-input-thing input) coreutils))) (equal? `(display ,(derivation->output-path (package-derivation %store coreutils))) (gexp->sexp* exp))))) (test-assert "one input package, dotted list" (let ((exp (gexp (coreutils . (ungexp coreutils))))) (and (gexp? exp) (match (gexp-inputs exp) ((input) (eq? (gexp-input-thing input) coreutils))) (equal? `(coreutils . ,(derivation->output-path (package-derivation %store coreutils))) (gexp->sexp* exp))))) (test-assert "one input origin" (let ((exp (gexp (display (ungexp (package-source coreutils)))))) (and (gexp? exp) (match (gexp-inputs exp) ((input) (and (eq? (gexp-input-thing input) (package-source coreutils)) (string=? (gexp-input-output input) "out")))) (equal? `(display ,(derivation->output-path (package-source-derivation %store (package-source coreutils)))) (gexp->sexp* exp))))) (test-assert "one local file" (let* ((file (search-path %load-path "guix.scm")) (local (local-file file)) (exp (gexp (display (ungexp local)))) (intd (add-to-store %store (basename file) #f "sha256" file))) (and (gexp? exp) (match (gexp-inputs exp) ((input) (and (eq? (gexp-input-thing input) local) (string=? (gexp-input-output input) "out")))) (equal? `(display ,intd) (gexp->sexp* exp))))) (test-assert "one local file, symlink" (let ((file (search-path %load-path "guix.scm")) (link (tmpnam))) (dynamic-wind (const #t) (lambda () (symlink (canonicalize-path file) link) (let* ((local (local-file link "my-file" #:recursive? #f)) (exp (gexp (display (ungexp local)))) (intd (add-to-store %store "my-file" #f "sha256" file))) (and (gexp? exp) (match (gexp-inputs exp) ((input) (and (eq? (gexp-input-thing input) local) (string=? (gexp-input-output input) "out")))) (equal? `(display ,intd) (gexp->sexp* exp))))) (lambda () (false-if-exception (delete-file link)))))) (test-equal "local-file, relative file name" (canonicalize-path (search-path %load-path "guix/base32.scm")) (let ((directory (dirname (search-path %load-path "guix/build-system/gnu.scm")))) (with-directory-excursion directory (let ((file (local-file "../guix/base32.scm"))) (local-file-absolute-file-name file))))) (test-equal "local-file, non-literal relative file name" (canonicalize-path (search-path %load-path "guix/base32.scm")) (let ((directory (dirname (search-path %load-path "guix/build-system/gnu.scm")))) (with-directory-excursion directory (let ((file (local-file (string-copy "../base32.scm")))) (local-file-absolute-file-name file))))) (test-equal "local-file, non-literal source relative file name" (current-filename) (let ((file (local-file (assume-source-relative-file-name (string-append "gexp" ".scm"))))) (local-file-absolute-file-name file))) (test-assert "local-file, relative file name, within gexp" (let* ((file (search-path %load-path "guix/base32.scm")) (interned (add-to-store %store "base32.scm" #f "sha256" file))) (equal? `(the file is ,interned) (gexp->sexp* #~(the file is #$(local-file "../guix/base32.scm")))))) (test-assert "local-file, relative file name, within gexp, compiled" ;; In Guile 3.0.8, everything read by the #~ and #$ read hash extensions ;; would lack source location info, which in turn would lead ;; (current-source-directory), called by 'local-file', to return #f, thereby ;; breaking 'local-file' resolution. See ;; <https://issues.guix.gnu.org/54003>. (let ((file (tmpnam))) (call-with-output-file file (lambda (port) (display (string-append "#~(this file is #$(local-file \"" (basename file) "\" \"t.scm\"))") port))) (let* ((interned (add-to-store %store "t.scm" #f "sha256" file)) (module (make-fresh-user-module))) (module-use! module (resolve-interface '(guix gexp))) (equal? `(this file is ,interned) (gexp->sexp* (load* file module)))))) (test-assertm "local-file, #:select?" (mlet* %store-monad ((select? -> (lambda (file stat) (member (basename file) '("guix.scm" "tests" "gexp.scm")))) (file -> (local-file ".." "directory" #:recursive? #t #:select? select?)) (dir (lower-object file))) (return (and (store-path? dir) (equal? (scandir dir) '("." ".." "guix.scm" "tests")) (equal? (scandir (string-append dir "/tests")) '("." ".." "gexp.scm")))))) (test-assert "one plain file" (let* ((file (plain-file "hi" "Hello, world!")) (exp (gexp (display (ungexp file)))) (expected (add-text-to-store %store "hi" "Hello, world!"))) (and (gexp? exp) (match (gexp-inputs exp) ((input) (and (eq? (gexp-input-thing input) file) (string=? (gexp-input-output input) "out")))) (equal? `(display ,expected) (gexp->sexp* exp)))))