[r2003-11-28 11:18:36 by szach] commented out validation against single attribute declaration

Original author: szach
Date: 2003-11-28 11:18:36+00:00

runtime/eval.ml

@@ -69,7 +69,9 @@ and eval_validate env e kind schema_name name =
       match Schema_common.get_component kind name schema with
       | Schema_types.Type x -> Schema_validator.validate_type x schema
       | Schema_types.Element x -> Schema_validator.validate_element x schema
-      | Schema_types.Attribute x -> Schema_validator.validate_attribute x schema
+      | Schema_types.Attribute x ->
+          assert false  (* TODO see schema/schema_validator.mli *)
+(*           Schema_validator.validate_attribute x schema *)
       | Schema_types.Attribute_group x ->
           Schema_validator.validate_attribute_group x schema
       | Schema_types.Model_group x ->
@@ -280,8 +282,6 @@ and eval_map env brs = function
 
 *)
 
-
-
 (* Evaluator for "compiled" expressions *)
 
 
@@ -449,8 +449,23 @@ and eval_ref env e t=
   Value.Record (Builtin_defs.mk_ref ~get ~set)
 
 and eval_validate env e kind schema_name name = 
-  raise (CDuceExn (string_latin1
-    "validate: not implemented for compiled expressions"))
+  let schema = Typer.get_schema schema_name in
+  try
+    let validate =
+      match Schema_common.get_component kind name schema with
+      | Schema_types.Type x -> Schema_validator.validate_type x schema
+      | Schema_types.Element x -> Schema_validator.validate_element x schema
+      | Schema_types.Attribute x ->
+          assert false  (* TODO see schema/schema_validator.mli *)
+(*           Schema_validator.validate_attribute x schema *)
+      | Schema_types.Attribute_group x ->
+          Schema_validator.validate_attribute_group x schema
+      | Schema_types.Model_group x ->
+          Schema_validator.validate_model_group x schema
+    in
+    validate (eval env e)
+  with Schema_common.XSI_validation_error msg ->
+    failwith' ("Schema validation failure: " ^ msg)
 
 and eval_try env arg brs =
   let saved_frame = !frame and saved_sp = !sp in