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.
This commit is contained in:
Timothy Sample 2019-05-19 19:47:45 -04:00
parent 0c57fc9ef9
commit 2d19d82444
1 changed files with 84 additions and 23 deletions

View File

@ -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)