summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsjamaan <>2016-02-14 12:51:56 +0000
committersjamaan <>2016-02-14 12:51:56 +0000
commite0fec8116f88be22715d4c9707009851e306059b (patch)
tree80782e36700e1aa79dd80fb0a4ff0599a1ac4a3e
parent83f1a37dea0044ca616d1f9e19e7b1db2053fd0a (diff)
downloadchicken-xml-rpc-e0fec8116f88be22715d4c9707009851e306059b.tar
chicken-xml-rpc-e0fec8116f88be22715d4c9707009851e306059b.tar.gz
chicken-xml-rpc-e0fec8116f88be22715d4c9707009851e306059b.tar.bz2
chicken-xml-rpc-e0fec8116f88be22715d4c9707009851e306059b.tar.lz
chicken-xml-rpc-e0fec8116f88be22715d4c9707009851e306059b.tar.xz
chicken-xml-rpc-e0fec8116f88be22715d4c9707009851e306059b.tar.zst
chicken-xml-rpc-e0fec8116f88be22715d4c9707009851e306059b.zip
xml-rpc: Fix nasty alist-ref hack that depended on comparison procedure argument order.
-rw-r--r--xml-rpc-client.scm4
-rw-r--r--xml-rpc-lolevel.scm13
-rw-r--r--xml-rpc-server.scm4
3 files changed, 11 insertions, 10 deletions
diff --git a/xml-rpc-client.scm b/xml-rpc-client.scm
index 6f60ae5..de65979 100644
--- a/xml-rpc-client.scm
+++ b/xml-rpc-client.scm
@@ -4,7 +4,7 @@
;;
;; This file contains a client implementation.
;
-; Copyright (c) 2009-2012, Peter Bex
+; Copyright (c) 2009-2012, 2016, Peter Bex
; Parts Copyright (c) Felix Winkelmann
; All rights reserved.
;
@@ -108,4 +108,4 @@
(lambda (p) (display xml p))
(lambda (p) (ssax:xml->sxml p '()))))))))
-) \ No newline at end of file
+)
diff --git a/xml-rpc-lolevel.scm b/xml-rpc-lolevel.scm
index d33b0c8..b0df44f 100644
--- a/xml-rpc-lolevel.scm
+++ b/xml-rpc-lolevel.scm
@@ -4,7 +4,7 @@
;;
;; This file contains the plumbing for XML RPC value marshaling/unmarshaling.
;
-; Copyright (c) 2009-2012, Peter Bex
+; Copyright (c) 2009-2012, 2016, Peter Bex
; Parts Copyright (c) Felix Winkelmann
; All rights reserved.
;
@@ -126,10 +126,11 @@
(,list? . ,list->xml-rpc-array))))
(define (value->xml-rpc-fragment value)
- ((alist-ref value (xml-rpc-unparsers)
- (lambda (pred? v) (pred? v))
- (lambda _ (error "No parser for value " value)))
- value))
+ (let ((pred&unparser (find (lambda (p&u) ((car p&u) value))
+ (xml-rpc-unparsers))))
+ (if pred&unparser
+ ((cdr pred&unparser) value)
+ (error "No parser for value " value))))
(define (xml-rpc-int->number fragment)
(string->number (sxml:text fragment)))
@@ -192,4 +193,4 @@
(lambda _ (error "No unparser for tag " (car fragment))))
fragment))
-) \ No newline at end of file
+)
diff --git a/xml-rpc-server.scm b/xml-rpc-server.scm
index d14ea58..52eebcc 100644
--- a/xml-rpc-server.scm
+++ b/xml-rpc-server.scm
@@ -4,7 +4,7 @@
;;
;; This file contains a server implementation.
;
-; Copyright (c) 2009-2012, Peter Bex
+; Copyright (c) 2009-2012, 2016, Peter Bex
; Parts Copyright (c) Felix Winkelmann
; All rights reserved.
;
@@ -155,4 +155,4 @@
(close-output-port out)))
(accept-next-connection)))))
-) \ No newline at end of file
+)