~ruther/guix-local

c8f9f24776040cc5645cf3b91b19946b1f1e4dac — Ludovic Courtès 10 years ago eda0522
guix build: Set the build options early.

This fixes a bug whereby, with grafts leading to builds very early,
build options such as --substitute-urls would not be taken into account
yet.

Reported by Andreas Enge <andreas@enge.fr>.

* guix/scripts/build.scm (guix-build): Move 'opts' to the beginning.
Use 'with-store' instead of 'open-connection'.  Call
'set-build-options-from-command-line' right after 'with-store'.
1 files changed, 51 insertions(+), 47 deletions(-)

M guix/scripts/build.scm
M guix/scripts/build.scm => guix/scripts/build.scm +51 -47
@@ 634,55 634,59 @@ needed."
;;;

(define (guix-build . args)
  (define opts
    (parse-command-line args %options
                        (list %default-options)))

  (with-error-handling
    ;; Ask for absolute file names so that .drv file names passed from the
    ;; user to 'read-derivation' are absolute when it returns.
    (with-fluids ((%file-port-name-canonicalization 'absolute))
      (let* ((opts  (parse-command-line args %options
                                        (list %default-options)))
             (store (open-connection))
             (mode  (assoc-ref opts 'build-mode))
             (drv   (options->derivations store opts))
             (urls  (map (cut string-append <> "/log")
                         (if (assoc-ref opts 'substitutes?)
                             (or (assoc-ref opts 'substitute-urls)
                                 ;; XXX: This does not necessarily match the
                                 ;; daemon's substitute URLs.
                                 %default-substitute-urls)
                             '())))
             (items (filter-map (match-lambda
                                  (('argument . (? store-path? file))
                                   file)
                                  (_ #f))
                                opts))
             (roots (filter-map (match-lambda
                                  (('gc-root . root) root)
                                  (_ #f))
                                opts)))

      (with-store store
        ;; Set the build options before we do anything else.
        (set-build-options-from-command-line store opts)
        (unless (assoc-ref opts 'log-file?)
          (show-what-to-build store drv
                              #:use-substitutes? (assoc-ref opts 'substitutes?)
                              #:dry-run? (assoc-ref opts 'dry-run?)
                              #:mode mode))

        (cond ((assoc-ref opts 'log-file?)
               (for-each (cut show-build-log store <> urls)
                         (delete-duplicates
                          (append (map derivation-file-name drv)
                                  items))))
              ((assoc-ref opts 'derivations-only?)
               (format #t "~{~a~%~}" (map derivation-file-name drv))
               (for-each (cut register-root store <> <>)
                         (map (compose list derivation-file-name) drv)
                         roots))
              ((not (assoc-ref opts 'dry-run?))
               (and (build-derivations store drv mode)
                    (for-each show-derivation-outputs drv)
                    (for-each (cut register-root store <> <>)
                              (map (lambda (drv)
                                     (map cdr
                                          (derivation->output-paths drv)))
                                   drv)
                              roots))))))))

        (let* ((mode  (assoc-ref opts 'build-mode))
               (drv   (options->derivations store opts))
               (urls  (map (cut string-append <> "/log")
                           (if (assoc-ref opts 'substitutes?)
                               (or (assoc-ref opts 'substitute-urls)
                                   ;; XXX: This does not necessarily match the
                                   ;; daemon's substitute URLs.
                                   %default-substitute-urls)
                               '())))
               (items (filter-map (match-lambda
                                    (('argument . (? store-path? file))
                                     file)
                                    (_ #f))
                                  opts))
               (roots (filter-map (match-lambda
                                    (('gc-root . root) root)
                                    (_ #f))
                                  opts)))

          (unless (assoc-ref opts 'log-file?)
            (show-what-to-build store drv
                                #:use-substitutes? (assoc-ref opts 'substitutes?)
                                #:dry-run? (assoc-ref opts 'dry-run?)
                                #:mode mode))

          (cond ((assoc-ref opts 'log-file?)
                 (for-each (cut show-build-log store <> urls)
                           (delete-duplicates
                            (append (map derivation-file-name drv)
                                    items))))
                ((assoc-ref opts 'derivations-only?)
                 (format #t "~{~a~%~}" (map derivation-file-name drv))
                 (for-each (cut register-root store <> <>)
                           (map (compose list derivation-file-name) drv)
                           roots))
                ((not (assoc-ref opts 'dry-run?))
                 (and (build-derivations store drv mode)
                      (for-each show-derivation-outputs drv)
                      (for-each (cut register-root store <> <>)
                                (map (lambda (drv)
                                       (map cdr
                                            (derivation->output-paths drv)))
                                     drv)
                                roots)))))))))