From 6ee5cf4423109ab64df58c85f4114e456dda098b Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Wed, 11 Jul 2018 13:03:33 +0530
Subject: [PATCH v3 1/3] build-system: python: Do not double wrap executables.
To: clement@lassieur.org
Cc: mhw@netris.org,
    andreas@enge.fr,
    32102@debbugs.gnu.org

* guix/build/python-build-system.scm (wrap): Only wrap executables that have
not already been wrapped.
* guix/build/utils.scm (is-wrapped?): New function.
---
 guix/build/python-build-system.scm | 9 ++++-----
 guix/build/utils.scm               | 9 +++++++++
 2 files changed, 13 insertions(+), 5 deletions(-)

diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm
index 376ea81f1..05e5009a4 100644
--- a/guix/build/python-build-system.scm
+++ b/guix/build/python-build-system.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; 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 (list-of-files dir)
-    (map (cut string-append dir "/" <>)
-         (or (scandir dir (lambda (f)
-                            (let ((s (stat (string-append dir "/" f))))
-                              (eq? 'regular (stat:type s)))))
-             '())))
+    (find-files dir (lambda (file stat)
+                      (and (eq? 'regular (stat:type stat))
+                           (not (is-wrapped? file))))))
 
   (define bindirs
     (append-map (match-lambda
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index c58a1afd1..c310b792c 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@
 
 (define-module (guix build utils)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -87,6 +89,7 @@
             patch-/usr/bin/file
             fold-port-matches
             remove-store-references
+            is-wrapped?
             wrap-program
 
             invoke
@@ -1003,6 +1006,12 @@ known as `nuke-refs' in Nixpkgs."
                              (put-u8 out (char->integer char))
                              result))))))
 
+(define (is-wrapped? prog)
+  "Return #t if PROG is already wrapped using wrap-program, else return #f."
+  (with-directory-excursion (dirname prog)
+    (and-let* ((match-record (string-match "^\\.(.*)-real$" (basename prog))))
+      (access? (match:substring match-record 1) X_OK))))
+
 (define* (wrap-program prog #:rest vars)
   "Make a wrapper for PROG.  VARS should look like this:
 
-- 
2.18.0