[cl-soap-cvs] CVS update: cl-soap/src/xsd.lisp

[Sven Van Caekenberghe]

Update of /project/cl-soap/cvsroot/cl-soap/src
In directory common-lisp.net:/tmp/cvs-serv12562/src

Modified Files:
	xsd.lisp 
Log Message:
fixed xsd primitive handling of false boolean

Date: Mon Sep 26 10:43:57 2005
Author: scaekenberghe

Index: cl-soap/src/xsd.lisp
diff -u cl-soap/src/xsd.lisp:1.11 cl-soap/src/xsd.lisp:1.12
--- cl-soap/src/xsd.lisp:1.11	Sun Sep 25 14:44:18 2005
+++ cl-soap/src/xsd.lisp	Mon Sep 26 10:43:56 2005
@@ -1,6 +1,6 @@
 ;;;; -*- mode: lisp -*-
 ;;;;
-;;;; $Id: xsd.lisp,v 1.11 2005/09/25 12:44:18 scaekenberghe Exp $
+;;;; $Id: xsd.lisp,v 1.12 2005/09/26 08:43:56 scaekenberghe Exp $
 ;;;;
 ;;;; A partial implementation of the XML Schema Definition standard
 ;;;;
@@ -357,12 +357,14 @@
 
 (defun new-lxml-primitive-value (name type lxml namespace)
   (let ((tag-name (intern name (s-xml:get-package namespace))))
-    (when (eql (lxml-get-tag lxml) tag-name)
-      (xsd-primitive->lisp (second lxml) (intern-xsd-type-name type)))))
+    (if (eql (lxml-get-tag lxml) tag-name)
+        (values (xsd-primitive->lisp (second lxml) (intern-xsd-type-name type)) t)
+      (values nil nil))))
 
 (defun new-resolve-primitive (element type-name lxml namespace)
-  (let ((value (new-lxml-primitive-value (get-name element) type-name lxml namespace)))
-    (if value
+  (multiple-value-bind (value present)
+      (new-lxml-primitive-value (get-name element) type-name lxml namespace)
+    (if present
         (values value t)
       (if (is-optional-p element)
           (values nil nil)
@@ -413,8 +415,7 @@
                             (push member-value resolved-members))))))))
           (values (nreverse resolved-members) t))
       (if (xsd-primitive-type-name-p type)
-          (let ((value (new-lxml-primitive-value (get-name super-element) type lxml namespace)))
-            (if value (values value t) (values nil nil)))
+          (new-lxml-primitive-value (get-name super-element) type lxml namespace)
         (error "unexpected type")))))
 
 (defun new-resolve-element (element lxml xml-schema-definition namespace)