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
;; on
;; 2010-05-24. It was written by Jim Bender and released
;; under the MIT/X11 license
;; .
+;;
+;; 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))