From a72ccbc25125d0d14cabdc1b0f824f27bb64478b Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 9 Oct 2015 12:33:40 -0400
Subject: [PATCH] build: container: Fix call-with-clean-exit.
Before, call-with-clean-exit would *always* return an exit code of 1.
* gnu/build/linux-container.scm (call-with-clean-exit): Exit with status
code of 0 if thunk does not throw an exception.
* tests/containers.scm: Add test.
---
gnu/build/linux-container.scm | 4 +++-
tests/containers.scm | 4 ++++
2 files changed, 7 insertions(+), 1 deletion(-)
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 95220d0bc08..e9114940586 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -36,7 +36,9 @@ (define (call-with-clean-exit thunk)
"Apply THUNK, but exit with a status code of 1 if it fails."
(dynamic-wind
(const #t)
- thunk
+ (lambda ()
+ (thunk)
+ (primitive-exit 0))
(lambda ()
(primitive-exit 1))))
diff --git a/tests/containers.scm b/tests/containers.scm
index 4783f8e8a56..0ba81491baa 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -34,6 +34,10 @@ (define (assert-exit x)
(test-begin "containers")
+(test-assert "call-with-container, exit with 0 when there is no error"
+ (zero?
+ (call-with-container '() (const #t) #:namespaces '(user))))
+
(test-assert "call-with-container, user namespace"
(zero?
(call-with-container '()
--
GitLab