[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-21-g7f622b
From: |
Andy Wingo |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-21-g7f622b8 |
Date: |
Thu, 17 Nov 2011 14:45:45 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=7f622b82a2ada4af1f78e27d1ef9ad1498305287
The branch, stable-2.0 has been updated
via 7f622b82a2ada4af1f78e27d1ef9ad1498305287 (commit)
from 46d80cae0876b63b460b2997c7e3bfab94461166 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 7f622b82a2ada4af1f78e27d1ef9ad1498305287
Author: Andy Wingo <address@hidden>
Date: Thu Nov 17 10:52:06 2011 +0100
eval.test work
* test-suite/tests/eval.test ("stacks"): Enable another test, fix to use
with-throw-handler, and remove a duplicate test, now that there is no
difference between subrs and gsubrs.
-----------------------------------------------------------------------
Summary of changes:
test-suite/tests/eval.test | 114 ++++++++++++++++---------------------------
1 files changed, 43 insertions(+), 71 deletions(-)
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index fe73707..a128cd7 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -330,77 +330,49 @@
0))
(with-test-prefix "stacks"
- (with-debugging-evaluator
-
- (pass-if "stack involving a subr"
- ;; The subr involving the error must appear exactly once on the stack.
- (catch 'result
- (lambda ()
- (throw 'unresolved)
- (start-stack 'foo
- (lazy-catch 'wrong-type-arg
- (lambda ()
- ;; Trigger a `wrong-type-arg' exception.
- (fluid-ref 'not-a-fluid))
- (lambda _
- (let* ((stack (make-stack #t))
- (frames (stack->frames stack)))
- (throw 'result
- (count (lambda (frame)
- (and (frame-procedure? frame)
- (eq? (frame-procedure frame)
- fluid-ref)))
- frames)))))))
- (lambda (key result)
- (= 1 result))))
-
- (pass-if "stack involving a gsubr"
- ;; The gsubr involving the error must appear exactly once on the stack.
- ;; This is less obvious since gsubr application may require an
- ;; additional `SCM_APPLY ()' call, which should not be visible to the
- ;; application.
- (catch 'result
- (lambda ()
- (throw 'unresolved)
- (start-stack 'foo
- (lazy-catch 'wrong-type-arg
- (lambda ()
- ;; Trigger a `wrong-type-arg' exception.
- (hashq-ref 'wrong 'type 'arg))
- (lambda _
- (let* ((stack (make-stack #t))
- (frames (stack->frames stack)))
- (throw 'result
- (count (lambda (frame)
- (and (frame-procedure? frame)
- (eq? (frame-procedure frame)
- hashq-ref)))
- frames)))))))
- (lambda (key result)
- (= 1 result))))
-
- (pass-if "arguments of a gsubr stack frame"
- ;; Create a stack with two gsubr frames and make sure the arguments are
- ;; correct.
- (catch 'result
- (lambda ()
- (start-stack 'foo
- (lazy-catch 'wrong-type-arg
- (lambda ()
- ;; Trigger a `wrong-type-arg' exception.
- (substring 'wrong 'type 'arg))
- (lambda _
- (let* ((stack (make-stack #t))
- (frames (stack->frames stack)))
- (throw 'result
- (map (lambda (frame)
- (cons (frame-procedure frame)
- (frame-arguments frame)))
- frames)))))))
- (lambda (key result)
- (and (equal? (car result) `(,make-stack #t))
- (pair? (member `(,substring wrong type arg)
- (cdr result)))))))))
+ (pass-if "stack involving a primitive"
+ ;; The primitive involving the error must appear exactly once on the
+ ;; stack.
+ (catch 'result
+ (lambda ()
+ (start-stack 'foo
+ (with-throw-handler 'wrong-type-arg
+ (lambda ()
+ ;; Trigger a `wrong-type-arg' exception.
+ (hashq-ref 'wrong 'type 'arg))
+ (lambda _
+ (let* ((stack (make-stack #t))
+ (frames (stack->frames stack)))
+ (throw 'result
+ (count (lambda (frame)
+ (eq? (frame-procedure frame)
+ hashq-ref))
+ frames)))))))
+ (lambda (key result)
+ (= 1 result))))
+
+ (pass-if "arguments of a primitive stack frame"
+ ;; Create a stack with two primitive frames and make sure the
+ ;; arguments are correct.
+ (catch 'result
+ (lambda ()
+ (start-stack 'foo
+ (with-throw-handler 'wrong-type-arg
+ (lambda ()
+ ;; Trigger a `wrong-type-arg' exception.
+ (substring 'wrong 'type 'arg))
+ (lambda _
+ (let* ((stack (make-stack #t))
+ (frames (stack->frames stack)))
+ (throw 'result
+ (map (lambda (frame)
+ (cons (frame-procedure frame)
+ (frame-arguments frame)))
+ frames)))))))
+ (lambda (key result)
+ (and (equal? (car result) `(,make-stack #t))
+ (pair? (member `(,substring wrong type arg)
+ (cdr result))))))))
;;;
;;; letrec init evaluation
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-21-g7f622b8,
Andy Wingo <=