Skip Menu |
 

This queue is for tickets about the XML-XPath CPAN distribution.

Report information
The Basics
Id: 6363
Status: resolved
Priority: 0/
Queue: XML-XPath

People
Owner: MANWAR [...] cpan.org
Requestors: MIROD [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 1.13
Fixed in: 1.23



Subject: using < in a query returns results as if <= had been used
Checking the results of queries using < against XML::LibXML returns failures. I went through the code with the debugger, evaluate goes properly into op_lt, which switches arguments and goes to op_gt, but then I can't figure out why it returns 1 for lh and rh both equal to 4. #!/usr/bin/perl -w use strict; use XML::XPath; use XML::LibXML; use Test::More qw(no_plan); my $xml='<root att="root_att"><daughter att="3"/><daughter att="4"/><daughter att="5"/></root>'; my @queries= ( '/root/daughter[@att<"4"]', '/root/daughter[@att<4]', '//daughter[@att<4]', '/root/daughter[@att>4]', # this one is OK ); my $xpath = XML::XPath->new( xml => $xml); my $libxml = XML::LibXML->new->parse_string( $xml); foreach my $path ( @queries) { print "find( '$path'):\n"; my @xpath_result = $xpath->findnodes( $path); my @libxml_result= $libxml->findnodes( $path); is( dump_nodes( @xpath_result) => dump_nodes( @libxml_result), "path: $path"); } sub dump_nodes { return join '-', map { $_->getName . "[" . $_->getAttribute( 'att') . "]" } @_ }
[MIROD - Wed May 19 10:46:46 2004]: OK, I got it, You were swapping things arouond so much in op_gt that you ended up not reversing the test properly and doing !b<a instead of a<b. Patch on Expr.pm attached, test below: #!/usr/bin/perl -w use strict; use XML::XPath; use Test::More; my $xml='<root att="root_att"><daughter att="3"/><daughter att="4"/><daughter att="5"/></root>'; my %results= ( '/root/daughter[@att<"4"]' => 'daughter[3]', '/root/daughter[@att<4]' => 'daughter[3]', '//daughter[@att<4]' => 'daughter[3]', '/root/daughter[@att>4]' => 'daughter[5]', '/root/daughter[@att>5]' => '', '/root/daughter[@att<3]' => '', ); plan tests => scalar keys %results; my $xpath = XML::XPath->new( xml => $xml); foreach my $path ( keys %results) { my @xpath_result = $xpath->findnodes( $path); is( dump_nodes( @xpath_result) => $results{$path}, "path: $path"); } sub dump_nodes { return join '-', map { $_->getName . "[" . $_->getAttribute( 'att') . "]" } @_ } __ Mirod
Download Expr.pm.patch
text/x-diff 1.6k
--- Expr.pm 2003-01-26 20:33:24.000000000 +0100 +++ Expr.pm.new 2004-05-19 19:39:22.261681184 +0200 @@ -430,29 +430,21 @@ # (that says: one is a nodeset, and one is not a nodeset) my ($nodeset, $other); - my ($true, $false); + my ($true, $false)= ( XML::XPath::Boolean->True, XML::XPath::Boolean->False); if ($lh_results->isa('XML::XPath::NodeSet')) { - $nodeset = $lh_results; - $other = $rh_results; - # we do this because unlike ==, these ops are direction dependant - ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); + foreach my $node ($lh_results->get_nodelist) { + if ($node->to_number->value > $rh_results->to_number->value) { + return $true; + } + } } else { - $nodeset = $rh_results; - $other = $lh_results; - # ditto above comment - ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); - } - - # True if and only if there is a node in the - # nodeset such that the result of performing - # the comparison on <type>(string_value($node)) - # is true. - foreach my $node ($nodeset->get_nodelist) { - if ($node->to_number->value > $other->to_number->value) { - return $true; + foreach my $node ($rh_results->get_nodelist) { + if ( $lh_results->to_number->value > $node->to_number->value) { + return $true; + } } - } + } return $false; } else { # Neither is a nodeset
Download (untitled) / with headers
text/plain 123b
[MIROD - Wed May 19 11:47:25 2004]: There was a similar problem in op_ge, which is fixed in the attached Expr.pm __ Mirod
Download Expr.pm
text/x-perl 23.8k

Message body is not shown because it is too large.

Download (untitled) / with headers
text/plain 201b
[MIROD - Wed May 19 13:24:08 2004]: Show quoted text
> [MIROD - Wed May 19 11:47:25 2004]: > > There was a similar problem in op_ge, which is fixed in the attached
Expr.pm Oops, wrong file! This one's good, __ Mirod
Download Expr.pm
text/x-perl 23.7k

Message body is not shown because it is too large.

Download (untitled) / with headers
text/plain 300b
Considering this bug has been open for quite a while, the fix available for about the same time, and I have a few modules now that depend on XML::XPath, I have published a patched version at: http://xmltwig.com/xml-xpath-patched/ I should not be too difficult to update XML::XPath itself. __ mirod
Download (untitled) / with headers
text/plain 517b
Hi all! On Wed Mar 02 05:06:46 2005, MIROD wrote: Show quoted text
> Considering this bug has been open for quite a while, the fix available > for about the same time, and I have a few modules now that depend on > XML::XPath, I have published a patched version at: > > http://xmltwig.com/xml-xpath-patched/ > > I should not be too difficult to update XML::XPath itself. > > __ > mirod
Attached is an updated patch for XML-XPath-1.22 for this bug. It was done as part of my Mageia Linux ( http://www.mageia.org/ ) packaging work.
Subject: XML-XPath-1.22-bug6363.diff
--- XML-XPath-1.22/MANIFEST.orig 2016-01-17 22:47:09.776470533 +0200 +++ XML-XPath-1.22/MANIFEST 2016-01-17 22:53:26.256886177 +0200 @@ -75,6 +75,7 @@ t/remove.t t/insert.t t/stress.t +t/test_comp_bug.t examples/test.xml examples/xpath META.yml Module YAML meta-data (added by MakeMaker) --- XML-XPath-1.22/lib/XML/XPath/Expr.pm.orig 2016-01-17 22:56:02.880382938 +0200 +++ XML-XPath-1.22/lib/XML/XPath/Expr.pm 2016-01-17 23:02:48.584493617 +0200 @@ -331,7 +331,7 @@ sub op_le { my ($node, $lhs, $rhs) = @_; - op_gt($node, $rhs, $lhs); + op_ge($node, $rhs, $lhs); } sub op_ge { @@ -360,31 +360,21 @@ !$rh_results->isa('XML::XPath::NodeSet'))) { # (that says: one is a nodeset, and one is not a nodeset) - my ($nodeset, $other); - my ($true, $false); if ($lh_results->isa('XML::XPath::NodeSet')) { - $nodeset = $lh_results; - $other = $rh_results; - # we do this because unlike ==, these ops are direction dependant - ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); + foreach my $node ($lh_results->get_nodelist) { + if ($node->to_number->value >= $rh_results->to_number->value) { + return XML::XPath::Boolean->True; + } + } } else { - $nodeset = $rh_results; - $other = $lh_results; - # ditto above comment - ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); - } - - # True if and only if there is a node in the - # nodeset such that the result of performing - # the comparison on <type>(string_value($node)) - # is true. - foreach my $node ($nodeset->get_nodelist) { - if ($node->to_number->value >= $other->to_number->value) { - return $true; + foreach my $node ($rh_results->get_nodelist) { + if ( $lh_results->to_number->value >= $node->to_number->value) { + return XML::XPath::Boolean->True; + } } } - return $false; + return XML::XPath::Boolean->False; } else { # Neither is a nodeset if ($lh_results->isa('XML::XPath::Boolean') || @@ -430,31 +420,22 @@ !$rh_results->isa('XML::XPath::NodeSet'))) { # (that says: one is a nodeset, and one is not a nodeset) - my ($nodeset, $other); - my ($true, $false); if ($lh_results->isa('XML::XPath::NodeSet')) { - $nodeset = $lh_results; - $other = $rh_results; - # we do this because unlike ==, these ops are direction dependant - ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); + foreach my $node ($lh_results->get_nodelist) { + if ($node->to_number->value > $rh_results->to_number->value) { + return XML::XPath::Boolean->True; + } + } } else { - $nodeset = $rh_results; - $other = $lh_results; - # ditto above comment - ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); - } - - # True if and only if there is a node in the - # nodeset such that the result of performing - # the comparison on <type>(string_value($node)) - # is true. - foreach my $node ($nodeset->get_nodelist) { - if ($node->to_number->value > $other->to_number->value) { - return $true; + foreach my $node ($rh_results->get_nodelist) { + if ( $lh_results->to_number->value > $node->to_number->value) { + return XML::XPath::Boolean->True; + } } } - return $false; + + return XML::XPath::Boolean->False; } else { # Neither is a nodeset if ($lh_results->isa('XML::XPath::Boolean') || @@ -579,8 +560,7 @@ $results->push($rhnode) unless exists $found{"$rhnode"}; } - $results->sort; - return $results; + return $results->sort->remove_duplicates; } die "Both sides of a union must be Node Sets\n"; } --- XML-XPath-1.22/lib/XML/XPath/LocationPath.pm.orig 2016-01-17 23:03:04.313342957 +0200 +++ XML-XPath-1.22/lib/XML/XPath/LocationPath.pm 2016-01-17 23:03:27.452121337 +0200 @@ -56,7 +56,7 @@ $nodeset = $step->evaluate($nodeset); } - return $nodeset; + return $nodeset->remove_duplicates; } 1; --- XML-XPath-1.22/t/test_comp_bug.t.orig 1970-01-01 01:00:00.000000000 +0100 +++ XML-XPath-1.22/t/test_comp_bug.t 2005-03-02 10:08:02.000000000 +0100 @@ -0,0 +1,31 @@ +#!/usr/bin/perl -w +use strict; +use XML::XPath; +use Test::More; + +my $xml='<root att="root_att"><daughter att="3"/><daughter +att="4"/><daughter att="5"/></root>'; +my %results= ( '/root/daughter[@att<"4"]' => 'daughter[3]', + '/root/daughter[@att<4]' => 'daughter[3]', + '//daughter[@att<4]' => 'daughter[3]', + '/root/daughter[@att>4]' => 'daughter[5]', + '/root/daughter[@att>5]' => '', + '/root/daughter[@att<3]' => '', + ); + +plan tests => scalar keys %results; + +my $xpath = XML::XPath->new( xml => $xml); + +foreach my $path ( keys %results) + { + my @xpath_result = $xpath->findnodes( $path); + is( dump_nodes( @xpath_result) => $results{$path}, "path: $path"); + } + + +sub dump_nodes + { return join '-', map { $_->getName . "[" . $_->getAttribute( 'att') +. "]" } @_ } + +
Download (untitled) / with headers
text/plain 267b
Hi, Thanks for raising the issue. I know this has been neglected for a long time. I am on the mission to sort this out. Your patch and test code helped me immensely. Much appreciated your support. I will very soon release the patch. Best Regards, Mohammad S Anwar
Resolved.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.