X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2Fregtest.ml;h=c6b598151b2127babf3df6f449274fe41c857caa;hb=54a8531f102cada0ed596af02913c7b6d8acc086;hp=e31b1da05645605bef43461df06f5368d9772171;hpb=57f2f0152b79ad7096b72b7e3e83939d63454a88;p=helm.git diff --git a/helm/gTopLevel/regtest.ml b/helm/gTopLevel/regtest.ml index e31b1da05..c6b598151 100644 --- a/helm/gTopLevel/regtest.ml +++ b/helm/gTopLevel/regtest.ml @@ -191,17 +191,33 @@ let as_expected report_fname expected found = (if Sys.file_exists report_fname then Sys.remove report_fname) ; let och = lazy (open_out report_fname) in let print_endline s = print_endline_to_channel (Lazy.force och) s in + let print_interpretation test = + print_endline "## Interpretation dump ##"; + print_endline "# Disambiguation environment:"; + print_endline test.eenv; + print_endline "# Metasenv:"; + print_endline test.emetasenv; + print_endline "# Term:"; + print_endline test.eterm; + print_endline "# Type:"; + print_endline test.etype; + print_endline "# Reduced term:"; + print_endline test.ereduced; + in let rec aux = function [],[] -> true | ex::extl, fo::fotl -> - as_expected_one och ex fo && - aux (extl,fotl) + let outcome1 = as_expected_one och ex fo in + let outcome2 = aux (extl,fotl) in + outcome1 && outcome2 | [],found -> - print_endline "### Too many interpretations found" ; + print_endline "### Too many interpretations found:" ; + List.iter print_interpretation found; false | expected,[] -> - print_endline "### Too few interpretations found" ; + print_endline "### Too few interpretations found:" ; + List.iter print_interpretation expected; false in let outcome = aux (expected,found) in @@ -259,8 +275,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 *) @@ -323,7 +339,8 @@ let _ = (if append_NL then prerr_endline else prerr_string) (HelmLogger.string_of_html_msg msg)); - let mqi_debug_fun = ignore in + let mqi_debug_fun s = + HelmLogger.log ~append_NL:true (`Msg (`T s)) in let mqi_handle = MQIConn.init ~log:mqi_debug_fun () in let fnames = ref [] in @@ -331,7 +348,8 @@ let _ = 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, @@ -344,14 +362,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; + if !varsprefix = "###" then varsprefix := !prefix ; + main mqi_handle !gen ((!gen || !dump) && (not !nodump)) !fnames !tryvars !prefix !varsprefix; MQIConn.close mqi_handle