aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
authorLudovic Courtès2007-12-14 12:40:45 +0100
committerLudovic Courtès2007-12-14 12:40:45 +0100
commit28d2d0f31f51e2b667f5a7fa3bd3347edf2d8e22 (patch)
tree20d124cedc9302ed0d974ae91aa7ad7646e139f6 /src/guile
parentf8b41ab7899927530b52b11f552ea9ceda866fea (diff)
downloadskribilo-28d2d0f31f51e2b667f5a7fa3bd3347edf2d8e22.tar.gz
skribilo-28d2d0f31f51e2b667f5a7fa3bd3347edf2d8e22.tar.lz
skribilo-28d2d0f31f51e2b667f5a7fa3bd3347edf2d8e22.zip
Return non-zero when an error is caught.
* src/guile/skribilo/condition.scm (%call-with-skribilo-error-catch): Make sure to always call EXIT. (call-with-skribilo-error-catch/exit): New. * src/pre-inst-skribilo.in: Use `call-with-skribilo-error-catch/exit'. * src/skribilo.in: Likewise.
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/condition.scm16
1 files changed, 9 insertions, 7 deletions
diff --git a/src/guile/skribilo/condition.scm b/src/guile/skribilo/condition.scm
index 3490135..46298f1 100644
--- a/src/guile/skribilo/condition.scm
+++ b/src/guile/skribilo/condition.scm
@@ -1,6 +1,6 @@
;;; condition.scm -- Skribilo SRFI-35 error condition hierarchy.
;;;
-;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2006, 2007 Ludovic Courtès <ludo@gnu.org>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -37,7 +37,8 @@
lookup-error-condition-handler
%call-with-skribilo-error-catch
- call-with-skribilo-error-catch))
+ call-with-skribilo-error-catch
+ call-with-skribilo-error-catch/exit))
;;; Author: Ludovic Courtès
;;;
@@ -129,7 +130,8 @@
(format (current-error-port)
(_ "in `~a': too few arguments: ~S~%")
(too-few-arguments-error:proc-name c)
- (too-few-arguments-error:arguments c)))
+ (too-few-arguments-error:arguments c))
+ (exit exit-val))
((file-search-error? c)
(format (current-error-port)
@@ -156,9 +158,7 @@
(file-error:file-name c))
(exit exit-val))
- (;;(skribilo-error? c)
- #t ;; XXX: The SRFI-35 currently in `guile-lib' doesn't work
- ;; properly with non-direct super-types.
+ ((skribilo-error? c)
(let ((handler (lookup-error-condition-handler c)))
(if (procedure? handler)
(handler c)
@@ -173,6 +173,8 @@
`(call/cc (lambda (cont)
(%call-with-skribilo-error-catch ,thunk cont #f))))
-;;; arch-tag: 285010f9-06ea-4c39-82c2-6c3604f668b3
+(define (call-with-skribilo-error-catch/exit thunk)
+ (%call-with-skribilo-error-catch thunk primitive-exit 1))
+
;;; conditions.scm ends here