diff options
-rw-r--r-- | module/sxml/match.scm | 5 | ||||
-rw-r--r-- | module/sxml/sxml-match.ss | 5 | ||||
-rw-r--r-- | test-suite/tests/sxml-match-tests.ss | 9 |
3 files changed, 17 insertions, 2 deletions
diff --git a/module/sxml/match.scm b/module/sxml/match.scm index 5b21deee8..d9d0285cf 100644 --- a/module/sxml/match.scm +++ b/module/sxml/match.scm @@ -81,11 +81,14 @@ ;;; Include upstream source file. ;;; -;; This file was taken unmodified from +;; This file was taken from ;; <http://planet.plt-scheme.org/package-source/jim/sxml-match.plt/1/1/> on ;; 2010-05-24. It was written by Jim Bender <benderjg2@aol.com> and released ;; under the MIT/X11 license ;; <http://www.gnu.org/licenses/license-list.html#X11License>. +;; +;; Modified the `sxml-match1' macro to allow multiple-value returns (upstream +;; was notified.) (include-from-path "sxml/sxml-match.ss") diff --git a/module/sxml/sxml-match.ss b/module/sxml/sxml-match.ss index b13971858..40d117944 100644 --- a/module/sxml/sxml-match.ss +++ b/module/sxml/sxml-match.ss @@ -1124,7 +1124,10 @@ [(sxml-match1 exp cata-fun clause0 clause ...) (let/ec escape (compile-clause clause0 exp cata-fun - (lambda () (escape (sxml-match1 exp cata-fun clause ...)))))])) + (lambda () (call-with-values + (lambda () (sxml-match1 exp cata-fun + clause ...)) + escape))))])) (define-syntax sxml-match (syntax-rules () diff --git a/test-suite/tests/sxml-match-tests.ss b/test-suite/tests/sxml-match-tests.ss index 39772b451..824d017ee 100644 --- a/test-suite/tests/sxml-match-tests.ss +++ b/test-suite/tests/sxml-match-tests.ss @@ -299,3 +299,12 @@ [(a (@ . ,qqq) ,t ...) (list qqq t ...)]) '(((z 1) (y 2) (x 3)) 4 5 6)) + +(run-test "test multiple value returns" + (call-with-values + (lambda () + (sxml-match '(foo) + ((foo) (values 'x 'y)))) + (lambda (x y) + (cons x y))) + '(x . y)) |