+++ /dev/null
-module Utils =
-struct
- type queryset = { documents : (string*int) array;
- queries : string array;}
-
- let make_queryset docs queries =
- { documents = Array.of_list (List.map (function f -> (f,(Unix.stat f).Unix.st_size)) docs);
- queries = Array.of_list queries
- }
-
-
- type stats = {
- mutable query : int; (* index in the query set *)
- mutable input_document : int; (* index in the query set *)
- mutable input_size : int;
- mutable print_output : bool;
-
- mutable input_parsing_time : float;
- mutable query_compile_time : float;
- mutable query_execution_time : float;
- mutable serialization_time : float;
-
- mutable memory_usage : int;
- }
-
- type stats_token =
- | Query of int
- | Input_document of int
- | Print_output of int
- | Input_size of int
- | Input_parsing_time of int
- | Query_compile_time of int
- | Query_execution_time of int
- | Serialization_time of int
- | Memory_usage of int
-
-
- let print_stats fmt s =
- Format.fprintf fmt "\
-Query number : %i
-Document number : %i
-Document size : %i bytes
-Output was serialized : %s
-Parsing time : %f ms
-Compile time : %f ms
-Execution time : %f ms
-Serialization time : %f ms
-Memory usage : %i kB\n" s.query
- s.input_document s.input_size (if s.print_output then "yes" else "no")
- s.input_parsing_time s.query_compile_time s.query_execution_time
- s.serialization_time (s.memory_usage/1024)
-
- let empty_stats () = {
- query = -1;
- input_document = -1;
- input_size = -1;
- print_output = false;
- input_parsing_time = infinity;
- query_compile_time = infinity;
- query_execution_time = infinity;
- serialization_time = infinity;
- memory_usage = 0
- }
-
- type result = (string*string)*(stats array list)
-
-
- let re_vmrss = Str.regexp ".*VmRSS:[^0-9]*\\([0-9]+\\) kB.*"
- let re_status = Str.regexp ".*Status:[^A-Z]*\\([A-Z]\\).*"
-
- let monitor_mem pid =
- let zombie = ref false in
- let rss = ref 0 in
- let in_c = open_in (Printf.sprintf "/proc/%i/status" pid) in
- let _ = try
- while true do
- let s = input_line in_c in
- if Str.string_match re_vmrss s 0
- then rss:= int_of_string (Str.matched_group 1 s);
- if Str.string_match re_status s 0
- then zombie:= (Str.matched_group 1 s) = "Z"
- done;
-
- with
- End_of_file -> close_in in_c
- in
- (!zombie,!rss*1024)
-
-
- let input_str = ref ""
-
- let get_res i = Str.matched_group i !input_str
-
- let rec match_out stats = function [] -> []
- | (s,l)::r ->
- if Str.string_match s !input_str 0
- then let () =
- List.iter
- (function Query i -> stats.query <- int_of_string (get_res i)
- | Input_document i -> stats.input_document <- int_of_string (get_res i)
- | Input_size i -> stats.input_size <- int_of_string (get_res i)
- | Print_output _ -> stats.print_output <- false;
- | Input_parsing_time i -> stats.input_parsing_time <- float_of_string (get_res i)
- | Query_compile_time i -> stats.query_compile_time <- float_of_string (get_res i)
- | Query_execution_time i -> stats.query_execution_time <- float_of_string (get_res i)
- | Serialization_time i -> stats.serialization_time <- float_of_string (get_res i)
- | Memory_usage i -> stats.memory_usage <- int_of_string (get_res i)) l
- in r
- else (s,l)::(match_out stats r)
-
- let parse_result pid in_c stats l =
- let descr = Unix.descr_of_in_channel in_c in
- let l = ref (List.map (fun (s,f) -> (Str.regexp s,f)) l) in
- try
- while !l <> [] && (0 == (fst (Unix.waitpid [ Unix.WNOHANG ] pid))) do
- let _ =
- match Unix.select [descr] [] [] 0.75 with
- | [d ],_,_ ->
- input_str := input_line in_c;
- l := match_out stats !l;
- | _ -> ()
- in
- if pid != 0 then
- let z,rss = monitor_mem pid in
- if rss > stats.memory_usage
- then stats.memory_usage <- rss;
- if z then raise End_of_file
- done
- with
- | End_of_file | Unix.Unix_error(Unix.ECHILD,_,_) -> ()
- | e -> raise e
-
- let build_xquery document query file print_output =
- let oc = open_out file in
- output_string oc "let $doc := doc(\"";
- output_string oc document;
- output_string oc "\") for $i in $doc";
- output_string oc query;
- output_string oc "\n let $a := ";
- if print_output
- then output_string oc "$i"
- else output_string oc "()";
- output_string oc "\n let $b := 1+1";
- output_string oc "\n return $a\n";
- close_out oc
-
- (* usually xslt processor take the filename
- as argument on the command line *)
- let build_xslt _ query file print_output =
- let oc = open_out file in
- output_string oc "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
-<xsl:stylesheet xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\"
- xmlns=\"http://www.w3.org/1999/xhtml\" version=\"1.0\">
-
-<xsl:template match=\"/\">
-<xsl:for-each select=\"";
- output_string oc query;
- output_string oc "\">
-<xsl:call-template name=\"out\"/>
- </xsl:for-each>
-</xsl:template>
-
-<xsl:template name=\"out\">\n";
- if print_output
- then output_string oc "<xsl:copy-of select=\".\"/>\n";
- output_string oc "</xsl:template>
-</xsl:stylesheet>\n";
- close_out oc
-;;
-
-
-end
-
-(* Signatures to build the test suite *)
-module type CONFIGURATION = sig
- val path : string
- val result_basename : string
- val num_runs : int
- val run_without_output : bool
- val run_with_output : bool
-end
-
-
-module type ENGINE = sig
- val name : string
- val description : string
- val command : string
- val mk_queryfile : bool -> (string -> string -> string -> unit)
- val mk_cmdline : bool -> string -> string -> string -> string -> string list
- val time_factor : float
- val reference : bool
- val parse_rules : (string * Utils.stats_token list) list
-end
-
-module type ENGINE_TESTER =
-sig
- module Conf : CONFIGURATION
- val test_engine : Utils.result list -> Utils.queryset -> Utils.result list
-end
-module INIT_TESTER (C : CONFIGURATION) : ENGINE_TESTER =
-struct
- module Conf = C
- let test_engine l _ = l
-end
-
-module MK (E: ENGINE) (C : ENGINE_TESTER) : ENGINE_TESTER =
-struct
- module Conf = C.Conf
- open Utils
-
- let run_query mem print_output qnum docnum qset =
- let docname = fst qset.documents.(docnum)
- in
- let query = qset.queries.(qnum) in
- let stats = empty_stats () in
- let qfile =
- Printf.sprintf "%s_%s_Q%.2d_D%.2d.query"
- Conf.result_basename E.name qnum docnum
- in
- let _ = (E.mk_queryfile print_output)
- docname query qfile
- in
- let qoutput = Printf.sprintf "%s_%s_Q%.2d_D%.2d.output"
- Conf.result_basename E.name qnum docnum
- in
- let cmdline = Array.of_list
- (E.command :: (E.mk_cmdline print_output qoutput qfile docname query))
- in
- let in_fd,out_fd = Unix.pipe () in
- let in_c = Unix.in_channel_of_descr in_fd in
- let pid = Unix.create_process E.command cmdline
- Unix.stdin out_fd out_fd
- in
- parse_result (if mem then pid else 0) in_c stats E.parse_rules;
- (try
- ignore(Unix.waitpid [] pid)
- with
- _ -> ());
- Unix.close in_fd;
- Unix.close out_fd;
- Some stats
-
- let extract = function Some a -> a | _ -> failwith "extract"
- let vb = function false -> 0 | _ -> 1
- let test_engine res qset =
- let header = (E.name, E.description) in
- let _ = Printf.printf "Testing engine %s\n%!" E.name in
- let lres = ref [] in
- let _ = Array.iteri
- (fun qnum _ ->
- Array.iteri ( fun docnum (_,docsize) ->
- let sres = [| (empty_stats()); (empty_stats()) |] in
- Printf.printf "Running query %.2d on document %.2d :\n%!" qnum docnum;
-
- for k = 0 to 1 do
- for j = (vb (not Conf.run_without_output)) to (vb Conf.run_with_output) do
- if j = 0 then Printf.printf "No output : \t%!"
- else Printf.printf "With output : \t%!";
- for i = 1 to Conf.num_runs do
- let s = extract(run_query (k==1) (j==1) qnum docnum qset) in
- sres.(j).query_execution_time <- s.query_execution_time;
- sres.(j).query_compile_time <- s.query_compile_time;
- if j == 1 then sres.(j).serialization_time <- s.serialization_time;
- if k == 1 then sres.(j).memory_usage <- s.memory_usage;
- Printf.printf "pass %i ... %!" i;
- done;
- Printf.printf "Ok\n%!";
- done;
- if (k == 0)
- then Printf.printf "Monitoring memory use: ... \n%!";
- done;
- let _ = Array.iteri (fun i s -> s.print_output <- (i==1);
- s.query <- qnum;
- s.input_document <- docnum;
- s.input_size <- docsize) sres
- in lres := sres::!lres
- ) qset.documents
- )qset.queries
- in
- C.test_engine ((header,!lres)::res) qset
-
-
-
-end
projects / SXSI / xpathcomp.git / blobdiff