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

Original author: afrisch
Date: 2005-02-22 17:57:04+00:00

schema/schema_builtin.ml

@@ -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

schema/schema_validator.ml

@@ -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 ... *)