build-system: python: Do not double wrap executables.

* guix/build/python-build-system.scm (wrap): Only wrap executables that have
not already been wrapped.
* guix/build/utils.scm (wrapper?): New function.
This commit is contained in:
Arun Isaac 2018-07-11 13:03:33 +05:30
parent 4ae7dc7b9a
commit 89e7f90d0b
No known key found for this signature in database
GPG key ID: 2E25EE8B61802BB3
2 changed files with 13 additions and 5 deletions

View file

@ -5,6 +5,7 @@
;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -186,11 +187,9 @@ when running checks after installing the package."
(define* (wrap #:key inputs outputs #:allow-other-keys) (define* (wrap #:key inputs outputs #:allow-other-keys)
(define (list-of-files dir) (define (list-of-files dir)
(map (cut string-append dir "/" <>) (find-files dir (lambda (file stat)
(or (scandir dir (lambda (f) (and (eq? 'regular (stat:type stat))
(let ((s (stat (string-append dir "/" f)))) (not (wrapper? file))))))
(eq? 'regular (stat:type s)))))
'())))
(define bindirs (define bindirs
(append-map (match-lambda (append-map (match-lambda

View file

@ -3,6 +3,7 @@
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -87,6 +88,7 @@
patch-/usr/bin/file patch-/usr/bin/file
fold-port-matches fold-port-matches
remove-store-references remove-store-references
wrapper?
wrap-program wrap-program
invoke invoke
@ -1003,6 +1005,13 @@ known as `nuke-refs' in Nixpkgs."
(put-u8 out (char->integer char)) (put-u8 out (char->integer char))
result)))))) result))))))
(define (wrapper? prog)
"Return #t if PROG is a wrapper as produced by 'wrap-program'."
(and (file-exists? prog)
(let ((base (basename prog)))
(and (string-prefix? "." base)
(string-suffix? "-real" base)))))
(define* (wrap-program prog #:rest vars) (define* (wrap-program prog #:rest vars)
"Make a wrapper for PROG. VARS should look like this: "Make a wrapper for PROG. VARS should look like this: