Commit 5a9d3cb0 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-02-22 17:57:04 by afrisch] Empty log message

Original author: afrisch
Date: 2005-02-22 17:57:04+00:00
parent 529e07bc
......@@ -134,9 +134,11 @@ let parse_sign s =
Value.vfalse
let validate_integer s =
try
Value.Integer (Intervals.V.mk (Utf8.get_str s))
with Failure _ -> simple_type_error "integer"
let s = Utf8.get_str s in
if (String.length s = 0) then simple_type_error "integer"
else
try Value.Integer (Intervals.V.mk s)
with Failure _ -> simple_type_error "integer"
let strip_decimal_RE = Pcre.regexp "\\..*$"
......@@ -188,10 +190,12 @@ let validate_token_list s =
Value.sequence (List.map validate_token (split_xml_S s))
let validate_interval interval type_name s =
let integer =
try
Intervals.V.mk (Utf8.get_str s)
with Failure _ -> simple_type_error type_name
let integer =
let s = Utf8.get_str s in
if (String.length s = 0) then simple_type_error "integer"
else
try Intervals.V.mk s
with Failure _ -> simple_type_error "integer"
in
if Intervals.contains integer interval then
Value.Integer integer
......
......@@ -138,9 +138,7 @@ let rec tries funs arg =
match funs with
| [] -> raise Not_found
| f :: tl ->
try
print_endline "try"; flush stdout;
f arg
try f arg
with XSI_validation_error _ ->
tries tl arg
......@@ -246,11 +244,10 @@ let rec validate_simple_type def s =
match def with
| Primitive name | Derived (Some name, _, _, _)
when Schema_builtin.is_builtin name ->
(try
Schema_builtin.validate_builtin name s
with Schema_builtin.Schema_builtin_error name ->
error (sprintf "%s isn't a valid %s"
(Utf8.to_string s) name))
(try Schema_builtin.validate_builtin name s
with Schema_builtin.Schema_builtin_error name ->
error (sprintf "%s isn't a valid %s"
(Utf8.to_string s) name))
| Primitive _ -> assert false
| Derived (_, Atomic primitive, facets, base) ->
let literal = normalize_white_space (fst facets.whiteSpace) s in
......@@ -265,11 +262,8 @@ let rec validate_simple_type def s =
Schema_facets.facets_valid facets value;
value
| Derived (_, Union members, facets, base) ->
print_endline ("union:" ^ (Utf8.to_string s)); flush stdout;
let value = tries (List.map validate_simple_type_ref members) s in
print_endline "after union"; flush stdout;
Schema_facets.facets_valid facets value;
print_endline "ok"; flush stdout;
value
| Derived (_, Restrict, _,_) as st ->
(* TODO: compute the restriction statically ... *)
......
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