petdance/test-www-mechanize

Validity checks in content_contains(), et al. are broken--'REGEX' vs 'Regexp'

Closed this issue · 1 comments

moregan commented

content_contains(), content_lacks(), and text_contains() try to make sure that they are not passed a regex rather than the required scalar. The check is ref eq 'REGEX', which does not work because ref on a regex returns 'Regexp'.

Also, these methods call diag() rather than $Test->diag().

Patch for the three functions plus tests for content_contains():

index fd49cf3..c1e304b 100644
--- a/Mechanize.pm
+++ b/Mechanize.pm
@@ -643,8 +643,9 @@ sub content_contains {
     my $desc = shift;

     local $Test::Builder::Level = $Test::Builder::Level + 1;
-    if ( ref($str) eq 'REGEX' ) {
-        diag( 'content_contains takes a string, not a regex' );
+
+    if ( ref($str) ) {
+        $Test->diag( 'content_contains requires a scalar' );
     }
     $desc = qq{Content contains "$str"} if !defined($desc);

@@ -663,8 +664,8 @@ sub content_lacks {
     my $desc = shift;

     local $Test::Builder::Level = $Test::Builder::Level + 1;
-    if ( ref($str) eq 'REGEX' ) {
-        diag( 'content_lacks takes a string, not a regex' );
+    if ( ref($str) ) {
+        $Test->diag( 'content_lacks requires a scalar' );
     }
     $desc = qq{Content lacks "$str"} if !defined($desc);

@@ -725,8 +726,8 @@ sub text_contains {
     my $desc = shift || qq{Text contains "$str"};

     local $Test::Builder::Level = $Test::Builder::Level + 1;
-    if ( ref($str) eq 'REGEX' ) {
-        diag( 'text_contains takes a string, not a regex' );
+    if ( ref($str) ) {
+        $Test->diag( 'text_contains requires a scalar' );
     }

     return contains_string( $self->content(format => "text"), $str, $desc );
diff --git a/t/content_contains.t b/t/content_contains.t
index 08c2566..3c9b987 100644
--- a/t/content_contains.t
+++ b/t/content_contains.t
@@ -2,7 +2,7 @@

 use strict;
 use warnings;
-use Test::More tests => 5;
+use Test::More tests => 9;
 use Test::Builder::Tester;

 BEGIN {
@@ -21,7 +21,22 @@ isa_ok($mech,'Test::WWW::Mechanize');

 $mech->get( "$server_root/goodlinks.html" );

-# test regex
+# passing a non-scalar not allowed
+foreach my $obj ( {}, [], qr/foo/, sub {} ) {
+    my $type = ref $obj;
+    test_out( "not ok 1 - Passing $type fails" );
+    test_diag( q(content_contains requires a scalar));
+    test_diag(qq(  Failed test 'Passing $type fails'));
+    test_diag( q(  at t/content_contains.t line 35.));
+    test_diag( q(    searched: "<html>\x{0a}    <head>\x{0a}        <title>Test Page</title>"...));
+    test_diag( q(  can't find: "(?-xism:foo)"));
+    test_diag( q(        LCSS: "oo"));
+    test_diag( q(LCSS context: "y>\x{0a}        <h1>Test Page</h1>\x{0a}        <a href="goo"));
+    $mech->content_contains( qr/foo/, "Passing $type fails" );
+    test_test( "Passing $type fails" );
+}
+
+# test success
 test_out( 'ok 1 - Does it say test page?' );
 $mech->content_contains( 'Test Page', 'Does it say test page?' );
 test_test( 'Finds the contains' );
@@ -31,6 +46,7 @@ test_out( 'ok 1 - Content contains "Test Page"' );
 $mech->content_contains( 'Test Page');
 test_test( 'Finds the contains - default desc' );

+# test failure
 test_out( 'not ok 1 - Where is Mungo?' );
 test_fail(+5);
 test_diag(q(    searched: "<html>\x{0a}    <head>\x{0a}        <title>Test Page</title>"...) );
petdance commented

This will be fixed in 1.34. Thanks.