GNU bug report logs - #14922
guard expression doesn't catch everything

Previous Next

Package: guile;

Reported by: Göran Weinholt <goran <at> weinholt.se>

Date: Sun, 21 Jul 2013 09:30:04 UTC

Severity: normal

Done: Mark H Weaver <mhw <at> netris.org>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 14922 in the body.
You can then email your comments to 14922 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to bug-guile <at> gnu.org:
bug#14922; Package guile. (Sun, 21 Jul 2013 09:30:04 GMT) Full text and rfc822 format available.

Acknowledgement sent to Göran Weinholt <goran <at> weinholt.se>:
New bug report received and forwarded. Copy sent to bug-guile <at> gnu.org. (Sun, 21 Jul 2013 09:30:05 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Göran Weinholt <goran <at> weinholt.se>
To: bug-guile <at> gnu.org
Subject: guard expression doesn't catch everything
Date: Sun, 21 Jul 2013 11:29:03 +0200
[Message part 1 (text/plain, inline)]
Hello schemers,

the guard expression from (rnrs) would be a lot more useful if it
managed to catch all exceptions. As it is now, some errors will bypass
the guard:

scheme@(guile-user)> (import (rnrs))
scheme@(guile-user)> (guard (exn (else #f)) (fx+ #f #f))
$1 = #f
scheme@(guile-user)> (guard (exn (else #f)) (fx+))
;;; <stdin>:3:0: warning: possibly wrong number of arguments to `fx+'
rnrs/arithmetic/fixnums.scm:153:2: In procedure fx+:
rnrs/arithmetic/fixnums.scm:153:2: Wrong number of arguments to #<procedure fx+ (fx1 fx2)>

The background is that I'm working on a program that intentionally calls
procedures with bad arguments, and it needs to determine if the
procedure accepted the arguments or not. Ideally the object raised would
be a proper and correct R6RS condition object, but I suspect that most
of the existing Guile code doesn't raise conditions like that. I think
it would be a step forward if guard at least caught the exception, even
if the condition object might not be very useful.

Tested with Guile 2.0.9.40-824b-dirty.

Regards,

-- 
Göran Weinholt <goran <at> weinholt.se>
"Bring me back // to a story left untold // so we can write the ending."
 -- Aly & Fila feat. Jwaydan - We Control The Sunlight
[Message part 2 (application/pgp-signature, inline)]

Information forwarded to bug-guile <at> gnu.org:
bug#14922; Package guile. (Sat, 10 Aug 2013 17:09:02 GMT) Full text and rfc822 format available.

Message #8 received at 14922 <at> debbugs.gnu.org (full text, mbox):

From: Mark H Weaver <mhw <at> netris.org>
To: guile-devel <at> gnu.org
Cc: Andreas Rottmann <a.rottmann <at> gmx.at>,
 Göran Weinholt <goran <at> weinholt.se>, 14922 <at> debbugs.gnu.org
Subject: Improving R6RS exception handling in Guile
Date: Sat, 10 Aug 2013 13:07:50 -0400
[Message part 1 (text/plain, inline)]
Hello all,

I've cooked up a patch to help improve R6RS exception handling in Guile.

As noted by Göran Weinholt in <http://bugs.gnu.org/14922>, the R6RS
exception handlers in Guile are currently unable to catch native Guile
exceptions.  To fix this, the basic approach of this patch is to convert
native Guile exceptions into R6RS conditions within the R6RS exception
handlers.

It's almost that simple, but there's one twist: if an R6RS exception
handler chooses not to handle a given exception, it will call 'raise'
again on the condition object, and here we must arrange to throw the
original Guile exception again.  We must do this because there's a lot
of Guile code out there that can only handle native Guile exceptions,
and which should not be broken by an R6RS exception handler somewhere in
the middle of the call stack.

We cope with this by including a special &guile condition object in the
compound condition that is produced by conversion.  Whenever 'raise' is
applied to such a condition, it will use the native Guile 'throw' with
the original KEY and ARGS stored in the &guile condition object.

Still to do: Modify the core Guile routines where needed (especially
I/O) to include enough information in exceptions to generate the
standard R6RS condition objects.

I'd be grateful for any feedback.

     Regards,
       Mark


[0001-Convert-guile-exceptions-to-R6RS-conditions-in-R6RS-.patch (text/x-diff, inline)]
From 6b2a6f3f91fc8078053727e45ee3e40515274bc3 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw <at> netris.org>
Date: Fri, 9 Aug 2013 18:27:20 -0400
Subject: [PATCH] Convert guile exceptions to R6RS conditions in R6RS
 exception handlers.

* module/rnrs/exceptions.scm (&guile): New condition type.

  (guile-condition-converters): New variable.

  (convert-guile-condition, default-guile-condition-converter,
  set-guile-condition-converter!, guile-common-conditions,
  guile-lexical-violation-converter, guile-syntax-violation-converter,
  guile-assertion-violation-converter, guile-system-error-converter,
  guile-undefined-violation-converter, guile-error-converter,
  guile-implementation-restriction-converter): New procedures.

  (with-exception-handler): Catch all exceptions, not just R6RS
  exceptions.  Convert native Guile exceptions to R6RS conditions,
  preserving the original Guile exception information in the &guile
  condition object.

  (raise, raise-continuable): If the condition includes a &guile
  condition, use 'throw' to throw the original native guile exception
  instead of raising an R6RS exception.

* test-suite/tests/r6rs-exceptions.test ("guile condition conversions"):
  Add tests.
---
 module/rnrs/exceptions.scm            |  158 +++++++++++++++++++++++++++++----
 test-suite/tests/r6rs-exceptions.test |   56 +++++++++++-
 2 files changed, 198 insertions(+), 16 deletions(-)

diff --git a/module/rnrs/exceptions.scm b/module/rnrs/exceptions.scm
index 95d01df..21aa391 100644
--- a/module/rnrs/exceptions.scm
+++ b/module/rnrs/exceptions.scm
@@ -1,6 +1,6 @@
 ;;; exceptions.scm --- The R6RS exceptions library
 
-;;      Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;      Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -29,14 +29,61 @@
                 newline
                 display
                 filter
+                acons
+                assv-ref
+                throw
                 set-exception-printer!
                 with-throw-handler
                 *unspecified*
                 @@))
 
-  (define raise (@@ (rnrs records procedural) r6rs-raise))
-  (define raise-continuable 
+  ;; When a native guile exception is caught by an R6RS exception
+  ;; handler, we convert it to an R6RS compound condition that includes
+  ;; not only the standard condition objects expected by R6RS code, but
+  ;; also a special &guile condition that preserves the original KEY and
+  ;; ARGS passed to the native Guile catch handler.
+
+  (define-condition-type &guile &condition
+    make-guile-condition guile-condition?
+    (key  guile-condition-key)
+    (args guile-condition-args))
+
+  (define (default-guile-condition-converter key args)
+    (condition (make-serious-condition)
+               (guile-common-conditions key args)))
+
+  (define (guile-common-conditions key args)
+    (apply (case-lambda
+             ((subr msg margs . _)
+              (condition (make-who-condition subr)
+                         (make-message-condition msg)
+                         (make-irritants-condition margs)))
+             (_ (make-irritants-condition args)))
+           args))
+
+  (define (convert-guile-condition key args)
+    (let ((converter (assv-ref guile-condition-converters key)))
+      (condition (or (and converter (converter key args))
+                     (default-guile-condition-converter key args))
+                 ;; Preserve the original KEY and ARGS in the R6RS
+                 ;; condition object.
+                 (make-guile-condition key args))))
+
+  ;; If an R6RS exception handler chooses not to handle a given
+  ;; condition, it will re-raise the condition to pass it on to the next
+  ;; handler.  If the condition was converted from a native Guile
+  ;; exception, we must re-raise using the native Guile facilities and
+  ;; the original exception KEY and ARGS.  We arrange for this in
+  ;; 'raise' so that native Guile exception handlers will continue to
+  ;; work when mixed with R6RS code.
+
+  (define (raise obj)
+    (if (guile-condition? obj)
+        (apply throw (guile-condition-key obj) (guile-condition-args obj))
+        ((@@ (rnrs records procedural) r6rs-raise) obj)))
+  (define raise-continuable
     (@@ (rnrs records procedural) r6rs-raise-continuable))
+
   (define raise-object-wrapper? 
     (@@ (rnrs records procedural) raise-object-wrapper?))
   (define raise-object-wrapper-obj
@@ -45,19 +92,22 @@
     (@@ (rnrs records procedural) raise-object-wrapper-continuation))
 
   (define (with-exception-handler handler thunk)
-    (with-throw-handler 'r6rs:exception
+    (with-throw-handler #t
      thunk
      (lambda (key . args)
-       (if (and (not (null? args))
-		(raise-object-wrapper? (car args)))
-	   (let* ((cargs (car args))
-		  (obj (raise-object-wrapper-obj cargs))
-		  (continuation (raise-object-wrapper-continuation cargs))
-		  (handler-return (handler obj)))
-	     (if continuation
-		 (continuation handler-return)
-		 (raise (make-non-continuable-violation))))
-	   *unspecified*))))
+       (cond ((not (eq? key 'r6rs:exception))
+              (let ((obj (convert-guile-condition key args)))
+                (handler obj)
+                (raise (make-non-continuable-violation))))
+             ((and (not (null? args))
+                   (raise-object-wrapper? (car args)))
+              (let* ((cargs (car args))
+                     (obj (raise-object-wrapper-obj cargs))
+                     (continuation (raise-object-wrapper-continuation cargs))
+                     (handler-return (handler obj)))
+                (if continuation
+                    (continuation handler-return)
+                    (raise (make-non-continuable-violation)))))))))
 
   (define-syntax guard0
     (syntax-rules ()
@@ -143,4 +193,82 @@
 
   (set-exception-printer! 'r6rs:exception exception-printer)
 
-)
+  ;; Guile condition converters
+  ;;
+  ;; Each converter is a procedure (converter KEY ARGS) that returns
+  ;; either an R6RS condition or #f.  If #f is returned,
+  ;; 'default-guile-condition-converter' will be used.
+
+  (define (guile-syntax-violation-converter key args)
+    (apply (case-lambda
+             ((who what where form subform . extra)
+              (condition (make-syntax-violation form subform)
+                         (make-who-condition who)
+                         (make-message-condition what)))
+             (_ #f))
+           args))
+
+  (define (guile-lexical-violation-converter key args)
+    (condition (make-lexical-violation) (guile-common-conditions key args)))
+
+  (define (guile-assertion-violation-converter key args)
+    (condition (make-assertion-violation) (guile-common-conditions key args)))
+
+  (define (guile-undefined-violation-converter key args)
+    (condition (make-undefined-violation) (guile-common-conditions key args)))
+
+  (define (guile-implementation-restriction-converter key args)
+    (condition (make-implementation-restriction-violation)
+               (guile-common-conditions key args)))
+
+  (define (guile-error-converter key args)
+    (condition (make-error) (guile-common-conditions key args)))
+
+  (define (guile-system-error-converter key args)
+    (apply (case-lambda
+             ((subr msg msg-args errno . rest)
+              ;; XXX TODO we should return a more specific error
+              ;; (usually an I/O error) as expected by R6RS programs.
+              ;; Unfortunately this often requires the 'filename' (or
+              ;; other?) which is not currently provided by the native
+              ;; Guile exceptions.
+              (condition (make-error) (guile-common-conditions key args)))
+             (_ (guile-error-converter key args)))
+           args))
+
+  ;; TODO: Arrange to have the needed information included in native
+  ;;       Guile I/O exceptions, and arrange here to convert them to the
+  ;;       proper conditions.  Remove the earlier exception conversion
+  ;;       mechanism: search for 'with-throw-handler' in the 'rnrs'
+  ;;       tree, e.g. 'with-i/o-filename-conditions' and
+  ;;       'with-i/o-port-error' in (rnrs io ports).
+
+  ;; XXX TODO: How should we handle the 'misc-error' and 'signal' native
+  ;;           Guile exceptions?
+
+  ;; XXX TODO: Should we handle the 'quit exception specially?
+
+  ;; An alist mapping native Guile exception keys to converters.
+  (define guile-condition-converters
+    `((read-error                . ,guile-lexical-violation-converter)
+      (syntax-error              . ,guile-syntax-violation-converter)
+      (unbound-variable          . ,guile-undefined-violation-converter)
+      (wrong-number-of-args      . ,guile-assertion-violation-converter)
+      (wrong-type-arg            . ,guile-assertion-violation-converter)
+      (keyword-argument-error    . ,guile-assertion-violation-converter)
+      (out-of-range              . ,guile-assertion-violation-converter)
+      (regular-expression-syntax . ,guile-assertion-violation-converter)
+      (program-error             . ,guile-assertion-violation-converter)
+      (goops-error               . ,guile-assertion-violation-converter)
+      (null-pointer-error        . ,guile-assertion-violation-converter)
+      (system-error              . ,guile-system-error-converter)
+      (host-not-found            . ,guile-error-converter)
+      (getaddrinfo-error         . ,guile-error-converter)
+      (no-data                   . ,guile-error-converter)
+      (no-recovery               . ,guile-error-converter)
+      (try-again                 . ,guile-error-converter)
+      (stack-overflow            . ,guile-implementation-restriction-converter)))
+
+  (define (set-guile-condition-converter! key proc)
+    (set! guile-condition-converters
+          (acons key proc guile-condition-converters))))
diff --git a/test-suite/tests/r6rs-exceptions.test b/test-suite/tests/r6rs-exceptions.test
index 54a4ddb..c6daa0f 100644
--- a/test-suite/tests/r6rs-exceptions.test
+++ b/test-suite/tests/r6rs-exceptions.test
@@ -1,6 +1,6 @@
 ;;; r6rs-exceptions.test --- Test suite for R6RS (rnrs exceptions)
 
-;;      Copyright (C) 2010 Free Software Foundation, Inc.
+;;      Copyright (C) 2010, 2013 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -20,6 +20,7 @@
 (define-module (test-suite test-rnrs-exceptions)
   :use-module ((rnrs conditions) :version (6))
   :use-module ((rnrs exceptions) :version (6))
+  :use-module (system foreign)
   :use-module (test-suite lib))
 
 (with-test-prefix "with-exception-handler"
@@ -96,3 +97,56 @@
 
   (pass-if "guard with cond => syntax"
     (guard (condition (condition => error?)) (raise (make-error)))))
+
+(with-test-prefix "guile condition conversions"
+
+  (define-syntax-rule (pass-if-condition name expected-condition? body ...)
+    (pass-if name
+      (guard (obj ((expected-condition? obj) #t)
+                  (else #f))
+        body ... #f)))
+
+  (pass-if "rethrown native guile exceptions"
+    (catch #t
+      (lambda ()
+        (guard (obj ((syntax-violation? obj) #f))
+          (vector-ref '#(0 1) 2)
+          #f))
+      (lambda (key . args)
+        (eq? key 'out-of-range))))
+
+  (pass-if-condition "syntax-error"
+                     syntax-violation?
+                     (eval '(let) (current-module)))
+
+  (pass-if-condition "unbound-variable"
+                     undefined-violation?
+                     variable-that-does-not-exist)
+
+  (pass-if-condition "out-of-range"
+                     assertion-violation?
+                     (vector-ref '#(0 1) 2))
+
+  (pass-if-condition "wrong-number-of-args"
+                     assertion-violation?
+                     ((lambda () #f) 'unwanted-argument))
+
+  (pass-if-condition "wrong-type-arg"
+                     assertion-violation?
+                     (vector-ref '#(0 1) 'invalid-index))
+
+  (pass-if-condition "keyword-argument-error"
+                     assertion-violation?
+                     ((lambda* (#:key a) #f) #:unwanted-keyword 'val))
+
+  (pass-if-condition "regular-expression-syntax"
+                     assertion-violation?
+                     (make-regexp "[missing-close-square-bracket"))
+
+  (pass-if-condition "null-pointer-error"
+                     assertion-violation?
+                     (dereference-pointer (make-pointer 0)))
+
+  (pass-if-condition "read-error"
+                     lexical-violation?
+                     (read (open-input-string "(missing-close-paren"))))
-- 
1.7.10.4


Information forwarded to bug-guile <at> gnu.org:
bug#14922; Package guile. (Thu, 15 Aug 2013 11:15:03 GMT) Full text and rfc822 format available.

Message #11 received at 14922 <at> debbugs.gnu.org (full text, mbox):

From: Göran Weinholt <goran <at> weinholt.se>
To: Mark H Weaver <mhw <at> netris.org>
Cc: Andreas Rottmann <a.rottmann <at> gmx.at>, guile-devel <at> gnu.org,
 14922 <at> debbugs.gnu.org
Subject: Re: Improving R6RS exception handling in Guile
Date: Thu, 15 Aug 2013 12:50:09 +0200
[Message part 1 (text/plain, inline)]
Mark H Weaver <mhw <at> netris.org> writes:

> Hello all,
>
> I've cooked up a patch to help improve R6RS exception handling in Guile.
>
> As noted by Göran Weinholt in <http://bugs.gnu.org/14922>, the R6RS
> exception handlers in Guile are currently unable to catch native Guile
> exceptions.  To fix this, the basic approach of this patch is to convert
> native Guile exceptions into R6RS conditions within the R6RS exception
> handlers.
[...]
> I'd be grateful for any feedback.

I think it's the right approach to take. I've tested the patch a little
and it's an improvement over the current state of affairs.

Regards,

-- 
Göran Weinholt <goran <at> weinholt.se>
"What's worse than clowns? Danish clowns."
  -- Mystery Science Theatre 3000
[Message part 2 (application/pgp-signature, inline)]

Reply sent to Mark H Weaver <mhw <at> netris.org>:
You have taken responsibility. (Mon, 18 Nov 2013 06:18:02 GMT) Full text and rfc822 format available.

Notification sent to Göran Weinholt <goran <at> weinholt.se>:
bug acknowledged by developer. (Mon, 18 Nov 2013 06:18:03 GMT) Full text and rfc822 format available.

Message #16 received at 14922-done <at> debbugs.gnu.org (full text, mbox):

From: Mark H Weaver <mhw <at> netris.org>
To: Göran Weinholt <goran <at> weinholt.se>
Cc: 14922-done <at> debbugs.gnu.org, guile-devel <at> gnu.org
Subject: Re: Improving R6RS exception handling in Guile
Date: Mon, 18 Nov 2013 01:16:58 -0500
Sorry for the long delay on this.

Göran Weinholt <goran <at> weinholt.se> writes:

> Mark H Weaver <mhw <at> netris.org> writes:
>
>> Hello all,
>>
>> I've cooked up a patch to help improve R6RS exception handling in Guile.
>>
>> As noted by Göran Weinholt in <http://bugs.gnu.org/14922>, the R6RS
>> exception handlers in Guile are currently unable to catch native Guile
>> exceptions.  To fix this, the basic approach of this patch is to convert
>> native Guile exceptions into R6RS conditions within the R6RS exception
>> handlers.
> [...]
>> I'd be grateful for any feedback.
>
> I think it's the right approach to take. I've tested the patch a little
> and it's an improvement over the current state of affairs.

I went ahead and pushed this patch to stable-2.0.  We can work on
incrementally improving it from there.

I'm closing this bug <http://bugs.gnu.org/14922>.

     Thanks!
       Mark




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Mon, 16 Dec 2013 12:24:04 GMT) Full text and rfc822 format available.

This bug report was last modified 10 years and 105 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.