~ruther/guix-local

5dce82180bf59b39184226830b74f33080fe00f3 — Ludovic Courtès 12 years ago cba363b
build-system/trivial: Implement the cross-build protocol.

* guix/build-system/trivial.scm (guile-for-build): New procedure.
  (trivial-build): Use it.
  (trivial-cross-build): New procedure.
  (trivial-build-system): Use it.
2 files changed, 37 insertions(+), 14 deletions(-)

M guix/build-system/trivial.scm
M tests/packages.scm
M guix/build-system/trivial.scm => guix/build-system/trivial.scm +27 -13
@@ 25,31 25,45 @@
  #:use-module (ice-9 match)
  #:export (trivial-build-system))

(define (guile-for-build store guile system)
  (match guile
    ((? package?)
     (package-derivation store guile system))
    ((and (? string?) (? derivation-path?))
     guile)
    (#f                                         ; the default
     (let* ((distro (resolve-interface '(gnu packages base)))
            (guile  (module-ref distro 'guile-final)))
       (package-derivation store guile system)))))

(define* (trivial-build store name source inputs
                        #:key
                        outputs guile system builder (modules '())
                        search-paths)
  "Run build expression BUILDER, an expression, for SYSTEM.  SOURCE is
ignored."
  (define guile-for-build
    (match guile
      ((? package?)
       (package-derivation store guile system))
      ((and (? string?) (? derivation-path?))
       guile)
      (#f                                         ; the default
       (let* ((distro (resolve-interface '(gnu packages base)))
              (guile  (module-ref distro 'guile-final)))
         (package-derivation store guile system)))))

  (build-expression->derivation store name system builder inputs
                                #:outputs outputs
                                #:modules modules
                                #:guile-for-build guile-for-build))
                                #:guile-for-build
                                (guile-for-build store guile system)))

(define* (trivial-cross-build store name target source inputs native-inputs
                              #:key
                              outputs guile system builder (modules '())
                              search-paths native-search-paths)
  "Like `trivial-build', but in a cross-compilation context."
  (build-expression->derivation store name system
                                `(begin (define %target ,target) ,builder)
                                (append native-inputs inputs)
                                #:outputs outputs
                                #:modules modules
                                #:guile-for-build
                                (guile-for-build store guile system)))

(define trivial-build-system
  (build-system (name 'trivial)
                (description
                 "Trivial build system, to run arbitrary Scheme build expressions")
                (build trivial-build)
                (cross-build trivial-build)))
                (cross-build trivial-cross-build)))

M tests/packages.scm => tests/packages.scm +10 -1
@@ 94,7 94,7 @@
                   ("d" ,d) ("d/x" "something.drv"))
                 (pk 'x (package-transitive-inputs e))))))

(test-skip (if (not %store) 5 0))
(test-skip (if (not %store) 6 0))

(test-assert "return values"
  (let-values (((drv-path drv)


@@ 203,6 203,15 @@
    (and (derivation-path? drv-path)
         (derivation? drv))))

(test-assert "package-cross-derivation, trivial-build-system"
  (let ((p (package (inherit (dummy-package "p"))
             (build-system trivial-build-system)
             (arguments '(#:builder (exit 1))))))
    (let-values (((drv-path drv)
                  (package-cross-derivation %store p "mips64el-linux-gnu")))
      (and (derivation-path? drv-path)
           (derivation? drv)))))

(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))
  (test-skip 1))
(test-assert "GNU Make, bootstrap"