Commit 6d72ae24 authored by Pietro Abate's avatar Pietro Abate
Browse files

[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
parent c51e94cc
......@@ -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))
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment