From 2d19d82444512733d5dd011b32640dcd7b8cb503 Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Sun, 19 May 2019 19:47:45 -0400
Subject: [PATCH] Make the bootstrap test more realistic.

Instead of building regular Bash using regular Gash, we now build
minimal Bash using the bootstrap build inputs, with bootstrap Bash
replaced by bootstrap Gash.

* tests/bootstrap/bash-without-bash.scm (gash-with-links): Rename this...
(%bootstrap-gash): ...to this, and use nothing but the bootstrap Guile
to build and run it.
(%bootstrap-coreutils&co-without-bash): New variable.
(%bootstrap-coreutils&co?): New function.
(%boot0-inputs): New variable.
---
 tests/bootstrap/bash-without-bash.scm | 107 ++++++++++++++++++++------
 1 file changed, 84 insertions(+), 23 deletions(-)

diff --git a/tests/bootstrap/bash-without-bash.scm b/tests/bootstrap/bash-without-bash.scm
index 39953ab..fac7723 100644
--- a/tests/bootstrap/bash-without-bash.scm
+++ b/tests/bootstrap/bash-without-bash.scm
@@ -1,5 +1,7 @@
-(use-modules ((gnu packages bash) #:select (bash))
+(use-modules ((gnu packages bash) #:select (bash-minimal))
+             (gnu packages bootstrap)
              (guix build-system)
+             (guix build-system trivial)
              (guix packages)
              (guix store)
              (guix utils)
@@ -8,30 +10,89 @@
 (define gash
   (load (string-append (current-source-directory) "/../../guix.scm")))
 
-(define gash-with-links
+(define %bootstrap-gash
   (package
     (inherit gash)
+    (build-system trivial-build-system)
     (arguments
-     (substitute-keyword-arguments (package-arguments gash)
-       ((#:phases phases '%standard-phases)
-        `(modify-phases ,phases
-           (add-after 'install 'link-bash
-             (lambda* (#:key outputs #:allow-other-keys)
-               (let ((out (assoc-ref outputs "out")))
-                 (symlink (string-append out "/bin/gash")
-                          (string-append out "/bin/sh"))
-                 (symlink (string-append out "/bin/gash")
-                          (string-append out "/bin/bash")))))))))))
+     `(#:guile ,%bootstrap-guile
+       #:modules ((guix build utils))
+       #:builder
+       (let* ((out     (assoc-ref %outputs "out"))
+              (source (assoc-ref %build-inputs "source"))
+              (guile-dir (assoc-ref %build-inputs "guile"))
+              (guile (string-append guile-dir "/bin/guile"))
+              (moddir (string-append out "/share/guile/site/"
+                                     (effective-version)))
+              (godir (string-append out "/lib/guile/"
+                                    (effective-version) "/site-ccache")))
+         (use-modules (guix build utils))
+         (format #t "Copying source files~%")
+         (copy-recursively source "source" #:log #f)
+         (format #t "Entering source directory~%")
+         (chdir "source")
+         (add-to-load-path (getcwd))
+         (format #t "Configuring gash/config.scm.in~%")
+         (copy-file "gash/config.scm.in" "gash/config.scm")
+         (substitute* "gash/config.scm"
+           (("@VERSION@") ,(package-version gash)))
+         (format #t "Configuring scripts/gash.in~%")
+         (copy-file "scripts/gash.in" "scripts/gash")
+         (substitute* "scripts/gash"
+           (("@GUILE@") guile)
+           (("@MODDIR@") moddir)
+           (("@GODIR@") godir))
+         (for-each (lambda (scm)
+                     (let ((go (string-append (string-drop-right scm 3) "go"))
+                           (dir (dirname scm)))
+                       (format #t "Compiling ~a~%" scm)
+                       (compile-file scm #:output-file go)
+                       (format #t "Installing ~a~%" scm)
+                       (install-file scm (string-append moddir "/" dir))
+                       (format #t "Installing ~a~%" go)
+                       (install-file go (string-append godir "/" dir))))
+                   (find-files "gash" "\\.scm$"))
+         (format #t "Installing scripts/gash~%")
+         (install-file "scripts/gash" (string-append out "/bin"))
+         (chmod (string-append out "/bin/gash") #o555)
+         (symlink (string-append out "/bin/gash")
+                  (string-append out "/bin/sh"))
+         (symlink (string-append out "/bin/gash")
+                  (string-append out "/bin/bash")))))
+    (inputs `(("guile" ,%bootstrap-guile)))
+    (native-inputs '())))
 
-(define bash-without-bash
-  (let ((bash-bag (package->bag bash)))
-    (bag
-      (inherit bash-bag)
-      (build-inputs
-       `(("bash" ,gash-with-links)
-         ,@(filter (match-lambda
-                     ((name . _)
-                      (not (member name '("bash")))))
-                   (bag-build-inputs bash-bag)))))))
+(define %bootstrap-coreutils&co-without-bash
+  (package
+    (inherit %bootstrap-coreutils&co)
+    (arguments
+     (substitute-keyword-arguments (package-arguments %bootstrap-coreutils&co)
+       ((#:builder _ #f)
+        `(let ((source (assoc-ref %build-inputs "source"))
+               (out (assoc-ref %outputs "out")))
+           (use-modules (guix build utils))
+           (copy-recursively source out)
+           (delete-file (string-append out "/bin/sh"))
+           (delete-file (string-append out "/bin/bash"))))))
+    (inputs
+     `(("source" ,%bootstrap-coreutils&co)))))
+
+(define (%bootstrap-coreutils&co? x)
+  (eq? %bootstrap-coreutils&co x))
+
+(define %boot0-inputs
+  (map (match-lambda
+         (("coreutils&co" (? %bootstrap-coreutils&co? value))
+          `("coreutils&co" ,%bootstrap-coreutils&co-without-bash))
+         (("bash" _)
+          `("bash" ,%bootstrap-gash))
+         (x x))
+       (@@ (gnu packages commencement) %boot0-inputs)))
+
+(package-with-bootstrap-guile
+ (package-with-explicit-inputs (package
+                                 (inherit bash-minimal)
+                                 (name "bash-boot0"))
+                               %boot0-inputs
+                               #:guile %bootstrap-guile))
 
-(bag->derivation (open-connection) bash-without-bash)