X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2Fregtest.ml;h=bee1c28166a54f555ee0448253b4f32b08a6b774;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=4e72bdd544616a50078e82e26910c2b2d84755e4;hpb=9b0237f419714f67bfe4ae0cdee2c59986588e50;p=helm.git diff --git a/helm/gTopLevel/regtest.ml b/helm/gTopLevel/regtest.ml index 4e72bdd54..bee1c2816 100644 --- a/helm/gTopLevel/regtest.ml +++ b/helm/gTopLevel/regtest.ml @@ -227,11 +227,13 @@ let as_expected report_fname expected found = let test_this mqi_handle uri_pred raw_term = let empty_context = [] in List.map - (function (env, metasenv, cic_term) -> + (function (env, metasenv, cic_term,ugraph ) -> let etype = try - CicPp.ppterm - (CicTypeChecker.type_of_aux' metasenv empty_context cic_term) + let ty, _ = + (CicTypeChecker.type_of_aux' metasenv empty_context cic_term ugraph) + in + CicPp.ppterm ty with _ -> "MALFORMED" in let ereduced = @@ -246,7 +248,7 @@ let test_this mqi_handle uri_pred raw_term = etype = etype ^ "\n"; ereduced = ereduced ^ "\n"; } - ) (BatchParser.parse mqi_handle ~uri_pred raw_term) + ) (BatchParser.parse mqi_handle ~uri_pred raw_term CicUniv.empty_ugraph) let dump_environment filename = try @@ -275,8 +277,8 @@ let restore_environment filename = else CicEnvironment.empty () -let main mqi_handle generate dump fnames tryvars varsprefix = - let uri_pred = BatchParser.uri_pred_of_conf tryvars varsprefix in +let main mqi_handle generate dump fnames tryvars prefix varsprefix = + let uri_pred = BatchParser.uri_pred_of_conf tryvars ~prefix ~varsprefix in if generate then begin (* gen mode *) @@ -338,16 +340,21 @@ let _ = (fun ?(append_NL = true) msg -> (if append_NL then prerr_endline else prerr_string) (HelmLogger.string_of_html_msg msg)); - - let mqi_debug_fun = ignore in - let mqi_handle = MQIConn.init ~log:mqi_debug_fun () in - + Helm_registry.load_from "gTopLevel.conf.xml"; + let dbd = + Mysql.quick_connect + ~host:(Helm_registry.get "db.host") + ~user:(Helm_registry.get "db.user") + ~database:(Helm_registry.get "db.database") + () + in let fnames = ref [] in let gen = ref false in let tryvars = ref false in let dump = ref false in let nodump = ref false in - let varsprefix = ref "" in + let prefix = ref "" in + let varsprefix = ref "###" in let usage = "regtest [OPTION] ... test1 ..." in let spec = ["-gen", Arg.Set gen, @@ -360,14 +367,19 @@ let _ = "--nodump", Arg.Set nodump, "do not dump the final environment" ; "-vars", Arg.Set tryvars, "try also variables" ; "-novars", Arg.Clear tryvars, "do not try variables (default)" ; + "-prefix", Arg.Set_string prefix, + "limit object choices to URIs beginning with prefix" ; + "--prefix", Arg.Set_string prefix, + "limit object choices to URIs beginning with prefix" ; "-varsprefix", Arg.Set_string varsprefix, - "limit variable choices to URIs beginning with prefix" ; + "limit variable choices to URIs beginning with prefix; overrides -prefix" ; "--varsprefix", Arg.Set_string varsprefix, - "limit variable choices to URIs beginning with prefix" ; + "limit variable choices to URIs beginning with prefix; overrides -prefix" ] in Arg.parse spec (fun filename -> fnames := filename::!fnames ) usage ; if !fnames = [] then Arg.usage spec (Sys.argv.(0) ^ ": missing argument test. You must provide at least one test file.\n" ^ usage) ; - main mqi_handle !gen ((!gen || !dump) && (not !nodump)) !fnames !tryvars !varsprefix; - MQIConn.close mqi_handle + if !varsprefix = "###" then varsprefix := !prefix ; + main dbd !gen ((!gen || !dump) && (not !nodump)) !fnames !tryvars !prefix !varsprefix; + Mysql.disconnect dbd