gnu: julia-pdmats: Update to 0.11.1.
[jackhill/guix/guix.git] / tests / inferior.scm
index 5fddb1f..9992077 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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.
 ;;;
@@ -26,6 +26,7 @@
   #: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)
       (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))
+                    (inferior-exception-arguments c))))
+      (inferior-eval '(throw 'a 'b 'c 'd) inferior)
+      'badness)))
+
 (test-equal "inferior-packages"
   (take (sort (fold-packages (lambda (package lst)
                                (cons (list (package-name package)
                               ,(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")))
                                                       "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))))