Permalink
Browse files

Added support for PerlX::MethodCallWithBlock.

  • Loading branch information...
1 parent df99748 commit e7189407246666609d23644e0732a8435422dfe0 @theory committed Sep 5, 2009
Showing with 54 additions and 0 deletions.
  1. +1 −0 Changes
  2. +18 −0 lib/Test/XPath.pm
  3. +35 −0 t/blocks.t
View
1 Changes
@@ -1,6 +1,7 @@
Revision history for Perl extension Test::XPath.
0.12
+ - Added support for PerlX::MethodCallWithBlock.
0.11 2009-09-04T22:16:11
- Edited the documentation for accuracy, grammar, etc.
View
18 lib/Test/XPath.pm
@@ -27,6 +27,9 @@ sub ok {
my $xpc = $self->{xpc};
my $Test = Test::Builder->new;
+ # Code and desc can be reversed, to support PerlX::MethodCallWithBlock.
+ ($code, $desc) = ($desc, $code) if ref $desc eq 'CODE';
+
if (ref $code eq 'CODE') {
# Gonna do some recursive testing.
my @nodes = $xpc->findnodes($xpath, $self->{node})
@@ -154,6 +157,13 @@ Test::XPath - Test XML and HTML content and structure with XPath expressions
shift->is( './@src', $css, "Style src should be $css");
}, 'Should have style' );
+ # Better yet, use PerlX::MethodCallWithBlock:
+ use PerlX::MethodCallWithBlock;
+ $tx->ok( '/html/head/style[@type="text/css"]', 'Should have style' ) {
+ my $css = shift @css;
+ shift->is( './@src', $css, "Style src should be $css");
+ };
+
=head1 Description
Use the power of XPath expressions to validate the structure of your XML and
@@ -384,6 +394,14 @@ something like this:
shift->is('./@id', ++$i, "ID should be $i in story $i");
}, 'Should have story elements' );
+Even better, use L<PerlX::MethodCallWithBlock|PerlX::MethodCallWithBlock>
+to pass a block to the method instead of a code reference:
+
+ my $i = 0;
+ $tx->ok( '//assets/story', 'Should have story elements' ) {
+ shift->is('./@id', ++$i, "ID should be $i in story $i");
+ };
+
For convenience, the XML::XPath object is also assigned to C<$_> for the
duration of the call to the code reference. Either way, you can call C<ok()>
and pass code references anywhere in the hierarchy. For example, to ensure
View
35 t/blocks.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+ eval { require PerlX::MethodCallWithBlock; };
+ plan skip_all => "PerlX::MethodCallWithBlock not installed" if $@;
+}
+
+use PerlX::MethodCallWithBlock;
+plan tests => 11;
+use Test::XPath;
+
+my $html = '<html><head><title>Hello</title><body><p><em><b>first</b></em></p><p><em><b>post</b></em></p></body></html>';
+
+ok my $xp = Test::XPath->new(
+ xml => $html,
+ is_html => 1,
+), 'Should be able to parse HTML';
+
+# Try a recursive call.
+$xp->ok( '/html/body/p', 'Find paragraphs' ) {
+ shift->ok('./em', 'Find em under para') {
+ shift->ok('./b', 'Find b under em');
+ };
+};
+
+# Now without descriptions.
+$xp->ok( '/html/body/p' ) {
+ shift->ok('./em') {
+ shift->ok('./b');
+ };
+};
+

0 comments on commit e718940

Please sign in to comment.