From 7b3318e34f4e2743254a88b908859901db960e9a Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Mon, 22 May 2017 16:13:15 +0200
Subject: [PATCH] gnu: Allow overriding of xgcc package in cross-gcc.

* gnu/packages/cross-base.scm (cross-gcc-arguments): Take extra "xgcc"
argument.
(cross-gcc): Use keyword arguments; take optional "xgcc" argument.
* gnu/packages/embedded.scm (gcc-arm-none-eabi-4.9, propeller-gcc, gcc-vc4):
Use keyword arguments.
* gnu/packages/avr.scm (avr-gcc-4.9): Likewise.
---
 gnu/packages/avr.scm        |  2 +-
 gnu/packages/cross-base.scm | 28 ++++++++++++++++------------
 gnu/packages/embedded.scm   |  7 ++++---
 3 files changed, 21 insertions(+), 16 deletions(-)

diff --git a/gnu/packages/avr.scm b/gnu/packages/avr.scm
index fd18ff6a9a..fc4eb8db0a 100644
--- a/gnu/packages/avr.scm
+++ b/gnu/packages/avr.scm
@@ -39,7 +39,7 @@ (define-public avr-binutils
     (name "avr-binutils")))
 
 (define-public avr-gcc-4.9
-  (let ((xgcc (cross-gcc "avr" avr-binutils)))
+  (let ((xgcc (cross-gcc "avr" #:xbinutils avr-binutils)))
     (package
       (inherit xgcc)
       (name "avr-gcc")
diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
index 47e0958193..54303b7b45 100644
--- a/gnu/packages/cross-base.scm
+++ b/gnu/packages/cross-base.scm
@@ -100,9 +100,9 @@ (define (cross-binutils target)
                binutils)
            target)))
 
-(define (cross-gcc-arguments target libc)
-  "Return build system arguments for a cross-gcc for TARGET, using LIBC (which
-may be either a libc package or #f.)"
+(define (cross-gcc-arguments target xgcc libc)
+  "Return build system arguments for a cross-gcc for TARGET, using XGCC as the
+base compiler and using LIBC (which may be either a libc package or #f.)"
   ;; Set the current target system so that 'glibc-dynamic-linker' returns the
   ;; right name.
   (parameterize ((%current-target-system target))
@@ -111,7 +111,7 @@ (define (cross-gcc-arguments target libc)
     ;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html>
     ;; for instance.
     (let ((args `(#:strip-binaries? #f
-                  ,@(package-arguments %xgcc))))
+                  ,@(package-arguments xgcc))))
      (substitute-keyword-arguments args
        ((#:configure-flags flags)
         `(append (list ,(string-append "--target=" target)
@@ -183,18 +183,22 @@ (define (cross-gcc-snippet target)
         (else #f)))
 
 (define* (cross-gcc target
-                    #:optional (xbinutils (cross-binutils target)) libc)
+                    #:key
+                    (xgcc %xgcc)
+                    (xbinutils (cross-binutils target))
+                    (libc #f))
   "Return a cross-compiler for TARGET, where TARGET is a GNU triplet.  Use
-XBINUTILS as the associated cross-Binutils.  If LIBC is false, then build a
-GCC that does not target a libc; otherwise, target that libc."
-  (package (inherit %xgcc)
+XGCC as the base compiler.  Use XBINUTILS as the associated cross-Binutils.
+If LIBC is false, then build a GCC that does not target a libc; otherwise,
+target that libc."
+  (package (inherit xgcc)
     (name (string-append "gcc-cross-"
                          (if libc "" "sans-libc-")
                          target))
-    (source (origin (inherit (package-source %xgcc))
+    (source (origin (inherit (package-source xgcc))
               (patches
                (append
-                (origin-patches (package-source %xgcc))
+                (origin-patches (package-source xgcc))
                 (cons (search-patch "gcc-cross-environment-variables.patch")
                       (cross-gcc-patches target))))
               (modules '((guix build utils)))
@@ -216,7 +220,7 @@ (define* (cross-gcc target
                   (srfi srfi-26)
                   (ice-9 regex))
 
-       ,@(cross-gcc-arguments target libc)))
+       ,@(cross-gcc-arguments target xgcc libc)))
 
     (native-inputs
      `(("ld-wrapper-cross" ,(make-ld-wrapper
@@ -230,7 +234,7 @@ (define* (cross-gcc target
        ("libc-native" ,@(assoc-ref (%final-inputs) "libc"))
 
        ;; Remaining inputs.
-       ,@(let ((inputs (append (package-inputs %xgcc)
+       ,@(let ((inputs (append (package-inputs xgcc)
                                (alist-delete "libc" (%final-inputs)))))
            (cond
             ((target-mingw? target)
diff --git a/gnu/packages/embedded.scm b/gnu/packages/embedded.scm
index b919bdf6c4..632682d630 100644
--- a/gnu/packages/embedded.scm
+++ b/gnu/packages/embedded.scm
@@ -52,7 +52,8 @@ (define-module (gnu packages embedded)
 ;; See https://launchpadlibrarian.net/218827644/release.txt
 (define-public gcc-arm-none-eabi-4.9
   (let ((xgcc (cross-gcc "arm-none-eabi"
-                         (cross-binutils "arm-none-eabi")))
+                         #:xgcc gcc-4.9
+                         #:xbinutils (cross-binutils "arm-none-eabi")))
         (revision "1")
         (svn-revision 227977))
     (package (inherit xgcc)
@@ -419,7 +420,7 @@ (define propeller-binutils
 
 (define-public propeller-gcc
   (let ((xgcc (cross-gcc "propeller-elf"
-                         propeller-binutils))
+                         #:xbinutils propeller-binutils))
         (commit "b4f45a4725e0b6d0af59e594c4e3e35ca4105867")
         (revision "1"))
     (package (inherit xgcc)
@@ -776,7 +777,7 @@ (define-public binutils-vc4
 
 (define-public gcc-vc4
   (let ((commit "165f6d0e11d2e76ee799533bb45bd5c92bf60dc2")
-        (xgcc (cross-gcc "vc4-elf" binutils-vc4)))
+        (xgcc (cross-gcc "vc4-elf" #:xbinutils binutils-vc4)))
     (package (inherit xgcc)
       (name "gcc-vc4")
       (source (origin