;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages guile)
+ #:use-module (gnu packages sqlite)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
'(a b c d)
(let ((inferior (open-inferior %top-builddir
#:command "scripts/guix")))
+ (guard (c ((inferior-exception? c)
+ (close-inferior inferior)
+ (and (eq? inferior (inferior-exception-inferior c))
+ (match (inferior-exception-stack c)
+ (((_ (files lines columns)) ..1)
+ (member "guix/repl.scm" files)))
+ (inferior-exception-arguments c))))
+ (inferior-eval '(throw 'a 'b 'c 'd) inferior)
+ 'badness)))
+
+(test-equal "&inferior-exception, legacy mode"
+ '(a b c d)
+ ;; Omit #:command to open an inferior in "legacy" mode, where Guile runs
+ ;; directly.
+ (let ((inferior (open-inferior %top-builddir)))
(guard (c ((inferior-exception? c)
(close-inferior inferior)
(and (eq? inferior (inferior-exception-inferior c))
,(package-version package)
,(package-location package))
,@rest)))))
- (list (map ->list (package-inputs guile-2.2))
- (map ->list (package-native-inputs guile-2.2))
- (map ->list (package-propagated-inputs guile-2.2))))
+ (list (map ->list (package-inputs guile-3.0-latest))
+ (map ->list (package-native-inputs guile-3.0-latest))
+ (map ->list (package-propagated-inputs guile-3.0-latest))))
(let* ((inferior (open-inferior %top-builddir
#:command "scripts/guix"))
(guile (first (lookup-inferior-packages inferior "guile")))
result))
(test-equal "inferior-package-search-paths"
- (package-native-search-paths guile-2.2)
+ (package-native-search-paths guile-3.0)
(let* ((inferior (open-inferior %top-builddir
#:command "scripts/guix"))
(guile (first (lookup-inferior-packages inferior "guile")))
"uh uh")))
#f)))
+(test-equal "inferior-eval-with-store, exception"
+ '(the-answer = 42)
+ (let ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix")))
+ (guard (c ((inferior-exception? c)
+ (close-inferior inferior)
+ (inferior-exception-arguments c)))
+ (inferior-eval-with-store inferior %store
+ '(lambda (store)
+ (throw 'the-answer '= 42))))))
+
+(test-equal "inferior-eval-with-store, not a procedure"
+ 'wrong-type-arg
+ (let ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix")))
+ (guard (c ((inferior-exception? c)
+ (close-inferior inferior)
+ (car (inferior-exception-arguments c))))
+ (inferior-eval-with-store inferior %store '(+ 1 2)))))
+
(test-equal "inferior-package-derivation"
(map derivation-file-name
(list (package-derivation %store %bootstrap-guile "x86_64-linux")
(list (inferior-package-derivation %store guile "x86_64-linux")
(inferior-package-derivation %store guile "armhf-linux")))))
+(unless (package-replacement sqlite)
+ (test-skip 1))
+
+(test-equal "inferior-package-replacement"
+ (package-derivation %store
+ (package-replacement sqlite)
+ "x86_64-linux")
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix"))
+ (packages (inferior-packages inferior)))
+ (match (lookup-inferior-packages inferior
+ (package-name sqlite)
+ (package-version sqlite))
+ ((inferior-sqlite rest ...)
+ (inferior-package-derivation %store
+ (inferior-package-replacement
+ inferior-sqlite)
+ "x86_64-linux")))))
+
(test-equal "inferior-package->manifest-entry"
(manifest-entry->list (package->manifest-entry
(first (find-best-packages-by-name "guile" #f))))