From 6aeda81602555fbeac0c0a209e74f5262093b513 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 9 Oct 2020 18:17:41 +0200
Subject: guix build: Add '--with-debug-info'.

* guix/scripts/build.scm (transform-package-with-debug-info): New
procedure.
(%transformations): Add 'with-debug-info'.
(%transformation-options, show-transformation-options-help): Add
'--with-debug-info'.
* tests/scripts-build.scm ("options->transformation, with-debug-info"):
New test.
* doc/guix.texi (Package Transformation Options): Document
'--with-debug-info'.
(Installing Debugging Files): Introduce sections.  Remove bit about
eventual "opt-out" since this is not happening.  Document
'--with-debug-info' under "Rebuilding with Debugging Info".
---
 guix/scripts/build.scm | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

(limited to 'guix')

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index e59e0ee67f..6ca669d172 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -474,6 +474,40 @@ the equal sign."
             obj)
         obj)))
 
+(define (transform-package-with-debug-info specs)
+  "Return a procedure that, when passed a package, set its 'replacement' field
+to the same package but with #:strip-binaries? #f in its 'arguments' field."
+  (define (non-stripped p)
+    (package
+      (inherit p)
+      (arguments
+       (substitute-keyword-arguments (package-arguments p)
+         ((#:strip-binaries? _ #f) #f)))))
+
+  (define (package-with-debug-info p)
+    (if (member "debug" (package-outputs p))
+        p
+        (let loop ((p p))
+          (match (package-replacement p)
+            (#f
+             (package
+               (inherit p)
+               (replacement (non-stripped p))))
+            (next
+             (package
+               (inherit p)
+               (replacement (loop next))))))))
+
+  (define rewrite
+    (package-input-rewriting/spec (map (lambda (spec)
+                                         (cons spec package-with-debug-info))
+                                       specs)))
+
+  (lambda (store obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
 (define (transform-package-tests specs)
   "Return a procedure that, when passed a package, sets #:tests? #f in its
 'arguments' field."
@@ -505,6 +539,7 @@ the equal sign."
     (with-commit . ,transform-package-source-commit)
     (with-git-url . ,transform-package-source-git-url)
     (with-c-toolchain . ,transform-package-toolchain)
+    (with-debug-info . ,transform-package-with-debug-info)
     (without-tests . ,transform-package-tests)))
 
 (define (transformation-procedure key)
@@ -536,6 +571,8 @@ the equal sign."
                   (parser 'with-git-url))
           (option '("with-c-toolchain") #t #f
                   (parser 'with-c-toolchain))
+          (option '("with-debug-info") #t #f
+                  (parser 'with-debug-info))
           (option '("without-tests") #t #f
                   (parser 'without-tests)))))
 
@@ -561,6 +598,9 @@ the equal sign."
   (display (G_ "
       --with-c-toolchain=PACKAGE=TOOLCHAIN
                          build PACKAGE and its dependents with TOOLCHAIN"))
+  (display (G_ "
+      --with-debug-info=PACKAGE
+                         build PACKAGE and preserve its debug info"))
   (display (G_ "
       --without-tests=PACKAGE
                          build PACKAGE without running its tests")))
-- 
cgit v1.2.3