[r2003-11-28 11:21:33 by szach] - bugfix: use empty record for attributs instead of the empty list

- bugfix: resolved Stream.failure while validating attribute uses

- bugfix: resolved parse error while validating elements

- commented out validate_attribute until the semantic is cleared

Original author: szach
Date: 2003-11-28 11:21:33+00:00

schema/schema_validator.ml

@@ -12,6 +12,9 @@ open Value
   (** {2 Misc} *)
 
 let empty_string = Value.string_utf8 (Utf8.mk "")
+let empty_record = Value.vrecord []
+let foo_atom = Value.Atom (Atoms.V.mk_ascii "foo")
+let foo_event = E_char_data (Utf8.mk "")
 
 let hashtbl_is_empty tbl =
   let empty = ref true in
@@ -315,7 +318,7 @@ let rec validate_element (context: validation_context) decl =
 
 and validate_type context = function
   | AnyType -> validate_any_type (context :> validation_context)
-  | Simple st_def -> (Value.nil, validate_simple_type_wrapper context st_def)
+  | Simple st_def -> (empty_record, validate_simple_type_wrapper context st_def)
   | Complex ct_def ->
       validate_complex_type (context :> validation_context) ct_def
 
@@ -552,6 +555,7 @@ let validate_type def schema value =
       Value.Xml (Value.Atom (Atoms.V.mk ns name), attrs, content)
 
 let validate_attribute decl schema value =
+  assert false; (* TODO see the .mli *)
   (match value with
   | Record _ -> ()
   | _ ->
@@ -564,6 +568,7 @@ let validate_attribute decl schema value =
   let rec aux = function
     | [] -> []
     | (qname', value) :: rest when qname' = qname ->
+        found := true;
         (qname', validate_simple_type st_def value) :: aux rest
     | field :: rest -> field :: aux rest
 
@@ -588,10 +593,11 @@ let validate_attribute_group def schema value =
     match value with
     | Record _ ->
         Stream.of_list
-          (List.map
+          ((List.map
             (fun (qname, v) ->
               E_attribute (qname, fst (Value.get_string_utf8 v)))
-            (Value.get_fields value))
+            (Value.get_fields value)) @
+            [ foo_event ])
     | _ ->
         validation_error
           "Only record values could be validated against attribute groups"
@@ -602,9 +608,7 @@ let validate_model_group def schema value =
   if not (Value.is_seq value) then
     validation_error
       "Only sequence values could be validated against model groups";
-  let stream =
-    stream_of_value (Value.Xml (Value.Absent, Value.Absent, value))
-  in
+  let stream = stream_of_value (Value.Xml (foo_atom, empty_record, value)) in
   Stream.junk stream;
   Value.sequence (validate_model_group (new context ~stream ~schema) (snd def))
 

schema/schema_validator.mli

@@ -23,7 +23,11 @@ val validate_type : type_definition -> schema -> Value.t -> Value.t
    * the attribute, add the corresponding field. Fails if there is neither the
    * field nor the default value.
    *)
-val validate_attribute : attribute_declaration -> schema -> Value.t -> Value.t
+(*  TODO (* commented out since the semantic isn't clear. Implementing the above
+ *  described semantic isn't that good since it generates records with more
+ *  fields than described in the corresponding closed record type *)
+  val validate_attribute : attribute_declaration -> schema -> Value.t -> Value.t
+*)
 
   (** CDuce domain: XML values *)
 val validate_element : element_declaration -> schema -> Value.t -> Value.t