From 074a201c33f822a7ab59512e7ee8b301204ff732 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Jan 2021 23:34:15 +0100 Subject: inferior: Add 'inferior-eval-with-store' tests. * tests/inferior.scm ("inferior-eval-with-store, exception") ("inferior-eval-with-store, not a procedure"): New tests. --- tests/inferior.scm | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) (limited to 'tests/inferior.scm') diff --git a/tests/inferior.scm b/tests/inferior.scm index 5fddb1fd13..fb12111343 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -213,6 +213,26 @@ "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") -- cgit v1.2.3 From 98d3abe7440717724263cacca8c36e9f43d53fcc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 Jan 2021 00:05:29 +0100 Subject: repl: Fix exception handling for interpreted code. The 'stack' variable could be #f when code is interpreted, which in practice happens when running in "legacy" mode--i.e., when 'open-inferior' invokes "guile" instead of "guix repl". * guix/repl.scm (send-repl-response)[handle-exception]: Check whether STACK is true before passing it to 'stack->frames'. * tests/inferior.scm ("&inferior-exception, legacy mode"): New test. --- guix/repl.scm | 8 +++++++- tests/inferior.scm | 12 ++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) (limited to 'tests/inferior.scm') diff --git a/guix/repl.scm b/guix/repl.scm index 0ace5976cf..94d85815ef 100644 --- a/guix/repl.scm +++ b/guix/repl.scm @@ -78,8 +78,14 @@ output port. VERSION is the client's protocol version we are targeting." (let ((stack (if (repl-prompt) (make-stack #t handle-exception (repl-prompt)) (make-stack #t)))) + ;; Note: 'make-stack' returns #f if there's no 'handle-exception' + ;; stack frame, which is the case when this file is being + ;; interpreted as with 'primitive-load'. `(exception (arguments ,key ,@(map value->sexp args)) - (stack ,@(map frame->sexp (stack->frames stack)))))) + (stack ,@(map frame->sexp + (if stack + (stack->frames stack) + '())))))) (_ ;; Protocol (0 0). `(exception ,key ,@(map value->sexp args))))) diff --git a/tests/inferior.scm b/tests/inferior.scm index fb12111343..7c3d730d0c 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -75,6 +75,18 @@ (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) -- cgit v1.2.3