From 5cfe8f8725b83eadae6923a10929b5db9204049c Mon Sep 17 00:00:00 2001 From: Lucca Hirschi Date: Fri, 13 Jul 2012 16:55:25 +0200 Subject: [PATCH] fix a bug: attributes were considered as nodes -> using first_child_x --- src/run.ml | 12 +++++----- src/solve.ml | 35 ++++++++++++++++------------- src/tree.ml | 14 ++++++++++-- src/tree.mli | 14 +++++++++++- tests/docs/XPath-FT.xml | 41 +++++++++++++++++++++++++++++++++- tests/queries/XPath-FT.queries | 2 +- 6 files changed, 92 insertions(+), 26 deletions(-) diff --git a/src/run.ml b/src/run.ml index fed18f0..fff387a 100644 --- a/src/run.ml +++ b/src/run.ml @@ -43,7 +43,7 @@ let rec bu_oracle asta run tree tnode = then () else NodeHash.add run node (map_leaf asta) else - let tfnode = Tree.first_child tree tnode + let tfnode = Tree.first_child_x tree tnode and tnnode = Tree.next_sibling tree tnode in let fnode,nnode = (* their preorders *) (Tree.preorder tree tfnode, Tree.preorder tree tnnode) in @@ -78,7 +78,7 @@ let rec bu_over_max asta run tree tnode = then () else - let tfnode = Tree.first_child tree tnode + let tfnode = Tree.first_child_x tree tnode and tnnode = Tree.next_sibling tree tnode in begin bu_over_max asta run tree tfnode; @@ -120,7 +120,7 @@ let rec tp_max asta run tree tnode = () else let node = Tree.preorder tree tnode - and tfnode = Tree.first_child tree tnode + and tfnode = Tree.first_child_x tree tnode and tnnode = Tree.next_sibling tree tnode in let (fnode,nnode) = (Tree.preorder tree tfnode, Tree.preorder tree tnnode) in @@ -175,10 +175,10 @@ let rec tp_max asta run tree tnode = and qnq,qnr = try NodeHash.find run nnode with | _ -> map_leaf asta in begin - if tfnode == Tree.nil + if tfnode == Tree.nil || Tree.is_attribute tree tnode then () else NodeHash.replace run fnode (StateSet.inter qfq ql,qfr); - if tnnode == Tree.nil + if tnnode == Tree.nil || Tree.is_attribute tree tnode then () else NodeHash.replace run nnode (StateSet.inter qnq qr,qnr); (* indeed we delete all states from self transitions! *) @@ -207,7 +207,7 @@ let selected_nodes tree asta = NodeHash.fold (fun key set acc -> if not(StateSet.is_empty - (StateSet.inter (fst set) (Asta.selec_states asta))) + (StateSet.inter (fst set) (Asta.selec_states asta))) then key :: acc else acc) run [] diff --git a/src/solve.ml b/src/solve.ml index b6dee3b..c94967d 100644 --- a/src/solve.ml +++ b/src/solve.ml @@ -32,47 +32,52 @@ let query () = let arg2 = Sys.argv.(2) in if arg2 = "-f" then let fq = open_in Sys.argv.(3) in - let rec list_qu fq list = - try - (match XPath.parse_file fq with - | q -> list_qu fq (q::list) - | _ -> list) + let rec list_qu fq list = + try let q = XPath.parse_file fq in + list_qu fq (q::list) with _ -> list in let list = list_qu fq [] in close_in fq; - fprintf err_formatter "Parse query OK ! "; + fprintf err_formatter "Parse query OK !\n %!"; list else failwith "Use -f" let build_asta query = let asta = Compil.trans query in - fprintf err_formatter "Compil OK ! "; asta let compute_run doc query = let run = Run.compute doc query in - fprintf err_formatter "Run OK ! \n"; run let () = + let flag = Array.length Sys.argv = 5 in Format.pp_set_margin err_formatter 80; let doc = doc () in output_string stderr "##### Doc with positions #####\n"; Tree.print_xml_preorder stderr doc (Tree.root doc); output_string stderr "\n"; let queries = query () in + let rec print_selec fmt l = match l with + | [x] -> fprintf fmt "%s" (string_of_int x) + | x :: tl -> fprintf fmt "%s" ((string_of_int x)^"; ");print_selec fmt tl + | [] -> fprintf fmt "%s" "ø" in let rec solve_queries = function | [] -> () | query :: tl -> let asta = build_asta query in let selected_nodes = Run.selected_nodes doc asta in - fprintf err_formatter "\n ### Query: %a\n" - XPath.Ast.print query; - let rec print_selec fmt l = match l with - | [x] -> fprintf fmt "%s" (string_of_int x) - | x :: tl -> fprintf fmt "%s" ((string_of_int x)^"; ");print_selec fmt tl - | [] -> fprintf fmt "%s" "ø" in + let run = compute_run doc asta in + fprintf err_formatter "\n ### Query: %a" + XPath.Ast.print query; fprintf err_formatter "@. ### Selected nodes: {%a}@." - print_selec selected_nodes in + print_selec selected_nodes; + if flag + then begin + Asta.print err_formatter asta; + Run.print err_formatter run; + end + else (); + solve_queries tl in solve_queries queries; exit 0 diff --git a/src/tree.ml b/src/tree.ml index 2b0fa4e..434d195 100644 --- a/src/tree.ml +++ b/src/tree.ml @@ -261,10 +261,16 @@ let rec print_xml out tree_ node = let root t = t.root let first_child _ n = n.first_child +let first_child_x _ n = + if n.first_child.tag == QName.attribute_map + then n.first_child.next_sibling + else n.first_child let next_sibling _ n = n.next_sibling let parent _ n = n.parent (* Begin Lucca Hirschi *) -let is_leaf t n = (first_child t n == nil) && (next_sibling t n == nil) +let is_leaf t n = (not (n.tag == QName.attribute_map)) && + (first_child t n == nil) && (next_sibling t n == nil) +let is_attribute t n = n.tag == QName.attribute_map (* End *) let tag _ n = n.tag let data _ n = n.data @@ -287,7 +293,8 @@ let rec print_xml_preorder out tree_ node = let fchild = if node.first_child.tag == QName.attribute_map then let () = - print_attributes out tree_ node.first_child.first_child + let ffn = node.first_child.first_child in + print_attributes out tree_ ffn; in node.first_child.next_sibling else @@ -303,3 +310,6 @@ let rec print_xml_preorder out tree_ node = end in print_xml_preorder out tree_ node.next_sibling + +let debug_node fmt t n = + Parser.debug_node fmt n diff --git a/src/tree.mli b/src/tree.mli index c75fd26..b64b0ff 100644 --- a/src/tree.mli +++ b/src/tree.mli @@ -49,6 +49,12 @@ val first_child : t -> node -> node Returns [nil] if [n] is a leaf. Returns [nil] if [n == nil]. *) +val first_child_x : t -> node -> node +(** [first_child t n] returns the first child which is not an attribute + of node [n] in tree [t]. + Returns [nil] if [n] is a leaf. Returns [nil] if [n == nil]. +*) + val next_sibling : t -> node -> node (** [next_sibling t n] returns the next_sibling of node [n] in tree [t]. Returns [nil] if [n] is the last child of a node. @@ -62,7 +68,10 @@ val parent : t -> node -> node *) val is_leaf : t -> node -> bool -(** Return true if the node is a *) +(** Return true if the node is a leaf or an attribute *) + +val is_attribute : t -> node -> bool +(** Return true if the node is an attribute *) val tag : t -> node -> QName.t (** Returns the label of a given node *) @@ -81,3 +90,6 @@ val preorder : t -> node -> int val print_xml_preorder : out_channel -> t -> node -> unit (** Outputs the tree with IDs for nodes as an XML document on the given output_channel *) + +val debug_node : Format.formatter -> t -> node -> unit +(** DEBUG *) diff --git a/tests/docs/XPath-FT.xml b/tests/docs/XPath-FT.xml index 90aef04..bd46991 100644 --- a/tests/docs/XPath-FT.xml +++ b/tests/docs/XPath-FT.xml @@ -1 +1,40 @@ -clergywomandecadentgentilityhappy-go-lucky manjigsawkerchiefThe letter L is followed by the letter:which is followed by the letter:ovenware

plentiful

quarrelsomesagetatteredvoluptuarywriggleyawnzuzzurellone + + +clergywoman +decadent + + + +gentility +happy-go-lucky man + + +jigsaw +kerchief + + + +The letter L is followed by the letter: + +which is followed by the letter: + +ovenware +

plentiful

+ + +quarrelsome + + +sage +tattered + + +voluptuary +wriggle + + + +yawn +zuzzurellone + + diff --git a/tests/queries/XPath-FT.queries b/tests/queries/XPath-FT.queries index bf29a0d..de956e9 100644 --- a/tests/queries/XPath-FT.queries +++ b/tests/queries/XPath-FT.queries @@ -1,4 +1,4 @@ -/descendant::L +/descendant::L/child::* /descendant::L/descendant::* /descendant::L/following-sibling::* /descendant::L/self::* -- 2.17.1