From c9df16e931bb1862caf7cdb46dd2e5a5579f0fef Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 29 Aug 2008 04:33:05 -0500 Subject: [PATCH] Tweak XML-RPC --- basis/xml-rpc/xml-rpc.factor | 14 +++++++------- core/generic/standard/standard-tests.factor | 11 ----------- 2 files changed, 7 insertions(+), 18 deletions(-) diff --git a/basis/xml-rpc/xml-rpc.factor b/basis/xml-rpc/xml-rpc.factor index 4b96d13316..ade9b34d93 100755 --- a/basis/xml-rpc/xml-rpc.factor +++ b/basis/xml-rpc/xml-rpc.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2005, 2006 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: kernel xml arrays math generic http.client combinators - hashtables namespaces io base64 sequences strings calendar - xml.data xml.writer xml.utilities assocs math.parser debugger - calendar.format math.order ; +USING: accessors kernel xml arrays math generic http.client +combinators hashtables namespaces io base64 sequences strings +calendar xml.data xml.writer xml.utilities assocs math.parser +debugger calendar.format math.order ; IN: xml-rpc ! * Sending RPC requests @@ -17,7 +17,7 @@ M: integer item>xml [ "Integers must fit in 32 bits" throw ] unless number>string "i4" build-tag ; -PREDICATE: boolean < object { t f } member? ; +UNION: boolean t POSTPONE: f ; M: boolean item>xml "1" "0" ? "boolean" build-tag ; @@ -147,10 +147,10 @@ TAG: array xml>item xml>item [ "faultCode" get "faultString" get ] bind ; : receive-rpc ( xml -- rpc ) - dup name-tag dup "methodCall" = + dup main>> dup "methodCall" = [ drop parse-method ] [ "methodResponse" = [ - dup first-child-tag name-tag "fault" = + dup first-child-tag main>> "fault" = [ parse-fault ] [ parse-rpc-response ] if ] [ "Bad main tag name" server-error ] if diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor index dd9ca267d2..e5f3ac8394 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/standard/standard-tests.factor @@ -317,14 +317,3 @@ M: xref-tuple-2 xref-test (xref-test) ; [ t ] [ \ + \ nth effective-method nip dup \ nth "default-method" word-prop eq? and ] unit-test - -GENERIC: wide-predicate-bug ( obj -- n ) - -PREDICATE: b-predicate < object { { } } member? ; - -M: b-predicate wide-predicate-bug drop 0 ; - -M: array wide-predicate-bug drop 1 ; - -[ 0 ] [ { } wide-predicate-bug ] unit-test -[ 1 ] [ { 1 } wide-predicate-bug ] unit-test