diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/lint.scm | 41 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 5 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 13 |
4 files changed, 41 insertions, 20 deletions
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 04ab852999..aceafc674d 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -878,24 +878,39 @@ move to the previous or next line") #:key (reporters %formatting-reporters)) "Report white-space issues in FILE starting from STARTING-LINE, and report them for PACKAGE." - (define last-line - ;; Number of the presumed last line. - ;; XXX: Ideally we'd stop at the boundaries of the surrounding sexp, but - ;; for now just use this simple heuristic. - (+ starting-line 60)) + (define (sexp-last-line port) + ;; Return the last line of the sexp read from PORT or an estimate thereof. + (define &failure (list 'failure)) + + (let ((start (ftell port)) + (start-line (port-line port)) + (sexp (catch 'read-error + (lambda () (read port)) + (const &failure)))) + (let ((line (port-line port))) + (seek port start SEEK_SET) + (set-port-line! port start-line) + (if (eq? sexp &failure) + (+ start-line 60) ;conservative estimate + line)))) (call-with-input-file file (lambda (port) - (let loop ((line-number 1)) + (let loop ((line-number 1) + (last-line #f)) (let ((line (read-line port))) (or (eof-object? line) - (> line-number last-line) - (begin - (unless (< line-number starting-line) - (for-each (lambda (report) - (report package line line-number)) - reporters)) - (loop (+ 1 line-number))))))))) + (and last-line (> line-number last-line)) + (if (and (= line-number starting-line) + (not last-line)) + (loop (+ 1 line-number) + (+ 1 (sexp-last-line port))) + (begin + (unless (< line-number starting-line) + (for-each (lambda (report) + (report package line line-number)) + reporters)) + (loop (+ 1 line-number) last-line))))))))) (define (check-formatting package) "Check the formatting of the source code of PACKAGE." diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 8da7a3fd3a..fa45bd48a6 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -486,6 +486,11 @@ Install, remove, or upgrade packages in a single transaction.\n")) arg-handler)))) (option '(#\u "upgrade") #f #t (lambda (opt name arg result arg-handler) + (when (and arg (string-prefix? "-" arg)) + (warning (G_ "upgrade regexp '~a' looks like a \ +command-line option~%") + arg) + (warning (G_ "is this intended?~%"))) (let arg-handler ((arg arg) (result result)) (values (alist-cons 'upgrade arg ;; Delete any prior "upgrade all" diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 35282f9027..0d36997bc4 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -113,7 +113,7 @@ (or (and=> (getenv "XDG_CACHE_HOME") (cut string-append <> "/guix/substitute")) (string-append %state-directory "/substitute/cache")) - (string-append (cache-directory) "/substitute"))) + (string-append (cache-directory #:ensure? #f) "/substitute"))) (define %allow-unauthenticated-substitutes? ;; Whether to allow unchecked substitutes. This is useful for testing diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 0fcb6a9b0f..5a2811e75b 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -431,8 +431,6 @@ generation as its default entry. STORE is an open connection to the store." "Re-install bootloader for existing system profile generation NUMBER. STORE is an open connection to the store." (let* ((generation (generation-file-name %system-profile number)) - (params (unless-file-not-found - (read-boot-parameters-file generation))) ;; Detect the bootloader used in %system-profile. (bootloader (lookup-bootloader-by-name (system-bootloader-name))) @@ -442,10 +440,12 @@ STORE is an open connection to the store." (bootloader bootloader))) ;; Make the specified system generation the default entry. - (entries (profile-boot-parameters %system-profile (list number))) + (params (profile-boot-parameters %system-profile (list number))) (old-generations (delv number (generation-numbers %system-profile))) - (old-entries (profile-boot-parameters - %system-profile old-generations))) + (old-params (profile-boot-parameters + %system-profile old-generations)) + (entries (map boot-parameters->menu-entry params)) + (old-entries (map boot-parameters->menu-entry old-params))) (run-with-store store (mlet* %store-monad ((bootcfg ((bootloader-configuration-file-generator bootloader) @@ -657,7 +657,8 @@ output when building a system derivation, such as a disk image." os (if (eq? 'init action) '() - (profile-boot-parameters))))) + (map boot-parameters->menu-entry + (profile-boot-parameters)))))) (bootcfg-file -> (bootloader-configuration-file bootloader)) (bootloader-installer (let ((installer (bootloader-installer bootloader)) |