Fix failing tests due to hash ordering changes in perl 5.18

Makefile.PL

@@ -12,15 +12,17 @@ WriteMakefile(
         : () ),
     PL_FILES  => {},
     PREREQ_PM => {
-        'Test::More'      => 0,
-        'Test::Exception' => 0,
-        'HTML::Entities'  => 0,
-        'HTML::Parser'    => 0,
-        'Scalar::Util'    => 0,
-        'Switch'          => 0,
-        'URI'             => 0,
-        'URI::Escape'     => 0,
-        'URI::Split'      => 0,
+        'Test::Differences' => 0,
+        'Test::More'        => 0,
+        'Test::Exception'   => 0,
+        'HTML::Entities'    => 0,
+        'HTML::Parser'      => 0,
+        'HTML::TreeBuilder' => 0,
+        'Scalar::Util'      => 0,
+        'Switch'            => 0,
+        'URI'               => 0,
+        'URI::Escape'       => 0,
+        'URI::Split'        => 0,
     },
     dist  => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
     clean => { FILES    => 'HTML-Laundry-*' },

t/add_attributes.t

@@ -3,18 +3,22 @@ use warnings;
 
 use Test::More tests => 8;
 
+use FindBin;
+use lib "$FindBin::RealBin/lib";
+use TestHelpers;
+
 require_ok('HTML::Laundry');
 use HTML::Laundry::Rules;
 my $rules = new HTML::Laundry::Rules;
 
 my $l1 = HTML::Laundry->new({ notidy => 1 });
 my $para = '<p class="austen" novel="emma">Sixteen years had Miss Taylor been in Mr. Woodhouse\'s family, less as a governess than a friend, very fond of both daughters, but particularly of Emma.</p>';
 is( $l1->clean($para), '<p class="austen">Sixteen years had Miss Taylor been in Mr. Woodhouse\'s family, less as a governess than a friend, very fond of both daughters, but particularly of Emma.</p>', 'Initial parsing strips unknown attribute.');
-my @acceptable = $l1->acceptable_attributes;
-my @original_acceptable = keys %{$rules->acceptable_a};
+my @acceptable = sort $l1->acceptable_attributes;
+my @original_acceptable = sort keys %{$rules->acceptable_a};
 is_deeply( \@acceptable, \@original_acceptable, 'acceptable_attributes() returns default Rules in list (not hash) form' );
 $l1->add_acceptable_attribute('novel');
-is( $l1->clean($para), $para, 'add_acceptable_attribute accepts single attribute');
+TestHelpers::eq_or_diff_html( $l1->clean($para), $para, 'add_acceptable_attribute accepts single attribute');
 $l1->add_acceptable_attribute(['magic_word','game']);
 my $adventure = '<div game="adventure"><p plugh="plover" magic_word="xyzzy">Nothing happens.</p></div>';
 is( $l1->clean($adventure), '<div game="adventure"><p magic_word="xyzzy">Nothing happens.</p></div>', 'add_acceptable_attribute accepts listref');
@@ -26,5 +30,3 @@ $l1->acceptable_attributes(['filfre', 'blorb', 'bozbar']);
 my @new_attributes = $l1->acceptable_attributes;
 ok( (scalar @new_attributes == 3 && grep {/^bozbar$/} @new_attributes),
     'acceptable_elements replaces all acceptable elements when given listref');
-
-

t/add_elements.t

@@ -10,8 +10,8 @@ my $rules = new HTML::Laundry::Rules;
 my $l1 = HTML::Laundry->new({ notidy => 1 });
 my $para = '<p>Sixteen years had <austen:footnote id="1">Miss Taylor</austen:footnote> been in Mr. Woodhouse\'s family, less as a governess than a friend, very fond of both daughters, but particularly of Emma.</p>';
 is( $l1->clean($para), '<p>Sixteen years had Miss Taylor been in Mr. Woodhouse\'s family, less as a governess than a friend, very fond of both daughters, but particularly of Emma.</p>', 'Initial parsing strips unknown tag.');
-my @acceptable = $l1->acceptable_elements;
-my @original_acceptable = keys %{$rules->acceptable_e};
+my @acceptable = sort $l1->acceptable_elements;
+my @original_acceptable = sort keys %{$rules->acceptable_e};
 is_deeply( \@acceptable, \@original_acceptable, 'acceptable_elements() returns default Rules in list (not hash) form' );
 $l1->add_acceptable_element('austen:footnote');
 is( $l1->clean($para), $para, 'add_acceptable_element prevents parser (notidy) from stripping element');
@@ -76,4 +76,4 @@ SKIP: {
     $l3->add_acceptable_element([ 'plugh', 'plover' ], { empty => 1});
     is( $l3->clean(q[<p><plugh /><plover /></p>]), '<p><plugh /><plover /></p>', 'Adding new empty elements via listref inserts them into Tidy\'s empty list');
     is( $l3->clean(q[Magic word? <swanzo></swanzo>]), q[Magic word? <swanzo />], 'Previous empty element still available');
-}
+}

t/add_unacceptable.t

@@ -9,9 +9,9 @@ use HTML::Laundry::Rules;
 my $l1 = HTML::Laundry->new({ notidy => 1 });
 my $script = '<p>Hello.</p><script>alert("Ha ha ha")</script>';
 is( $l1->clean($script), '<p>Hello.</p>', 'Initial parsing treats script as unacceptable' );
-my @unacceptable = $l1->unacceptable_elements;
+my @unacceptable = sort $l1->unacceptable_elements;
 my $rules = new HTML::Laundry::Rules;
-my @original_unacceptable = keys %{$rules->unacceptable_e};
+my @original_unacceptable = sort keys %{$rules->unacceptable_e};
 is_deeply( \@unacceptable, \@original_unacceptable, 'unacceptable_elements() returns default Rules in list (not hash) form' );
 $l1->add_unacceptable_element('p');
 is( $l1->clean($script), '', 'add_unacceptable_element accepts single attribute');
@@ -22,7 +22,7 @@ is( $l1->clean('<script>alert("Ha ha ha");</script><div>foo</div><span>bar</span
     'remove_unacceptable_element accepts single element but does not make it acceptable');
 $l1->remove_unacceptable_element(['div','span']);
 is( $l1->clean('<script>alert("Ha ha ha");</script><div>foo</div><span>bar</span><p>baz</p>'), 'alert(&quot;Ha ha ha&quot;);foobar',
-    'remove_unacceptable_element accepts listref but does not make any elements acceptable');    
+    'remove_unacceptable_element accepts listref but does not make any elements acceptable');
 $l1->unacceptable_elements(['ol','plugh','plover','gaspar','cleesh']);
 my @new_unacceptable = $l1->unacceptable_elements;
 ok( (scalar @new_unacceptable == 5 && grep {/^gaspar$/} @new_unacceptable),

t/callbacks.t

@@ -3,6 +3,10 @@ use warnings;
 
 use Test::More tests => 45;
 
+use FindBin;
+use lib "$FindBin::RealBin/lib";
+use TestHelpers;
+
 require_ok('HTML::Laundry');
 
 my $l = HTML::Laundry->new({ notidy => 31 });
@@ -113,7 +117,7 @@ $l->add_callback('start_tag', sub {
     }
 });
 $output = $l->clean( q{<img src="http://www.example.com/static/otter.png" />} );
-is( $output, q{<img alt="srly ttr bby!" src="http://www.example.com/static/otter.png" />}, 'Start_tag callbacks may be chained');
+TestHelpers::eq_or_diff_html( $output, q{<img alt="srly ttr bby!" src="http://www.example.com/static/otter.png" />}, 'Start_tag callbacks may be chained');
 $l->clear_callback('start_tag');
 
 $l->add_callback('end_tag', \&end_test );
@@ -204,14 +208,14 @@ $l->clear_callback('output');
 $l->add_callback('uri', \&uri_test );
 my $image = q{<p>Some text, and then: <img alt="Surly otter baby!" src="http://www.example.com/static/otter.png" class="exciting" /></p>};
 $output = $l->clean( $image );
-is( $output, q{<p>Some text, and then: <img alt="Surly otter baby!" src="https://www.example.com/static/otter.png" class="exciting" /></p>},
+TestHelpers::eq_or_diff_html( $output, q{<p>Some text, and then: <img alt="Surly otter baby!" src="https://www.example.com/static/otter.png" class="exciting" /></p>},
     q{URI callback allows manipulation of URI});
 $l->clear_callback('uri');
 $output = $l->clean($image);
-is( $output, $image, 'Cleared URI callback turns off callback' );
+TestHelpers::eq_or_diff_html( $output, $image, 'Cleared URI callback turns off callback' );
 $l->add_callback('uri', \&cancel );
 $output = $l->clean($image);
-is( $output, q{<p>Some text, and then: <img alt="Surly otter baby!" class="exciting" /></p>}, 'URI callback allows of entire attribute via false return');
+TestHelpers::eq_or_diff_html( $output, q{<p>Some text, and then: <img alt="Surly otter baby!" class="exciting" /></p>}, 'URI callback allows of entire attribute via false return');
 $l->clear_callback('uri');
 $l->add_callback('uri', sub {
     my ( $laundry, $tagname, $attr, $uri_ref ) = @_;
@@ -231,4 +235,4 @@ $l->add_callback('uri', sub {
 } );
 $output = $l->clean('<a href="http://google.com">Google</a>');
 is( $output, q{<a href="http://goglle.com/">Google</a>});
-$l->clear_callback('uri');
+$l->clear_callback('uri');

t/lib/TestHelpers.pm

@@ -0,0 +1,30 @@
+package TestHelpers;
+
+use strict;
+use warnings;
+
+use HTML::TreeBuilder;
+use Test::Differences 'eq_or_diff_text';
+
+# This is a minimal clone of Test::Differences::HTML
+# which has failing tests because Test::Differences has changed the output
+# in version 0.63 (see RT#100514)
+sub eq_or_diff_html {
+    my ($raw, $expected, $label) = @_;
+
+    return eq_or_diff_text(_normalise_html($raw), _normalise_html($expected), $label);
+}
+
+sub _normalise_html {
+    my ($dirty_html) = @_;
+
+    # Normalise the HTML by parsing it
+    my $tree      = HTML::TreeBuilder->new_from_content($dirty_html);
+    my $clean_html = $tree->as_HTML;
+
+    $tree = $tree->delete; # don't assume we have TreeBuilder 5
+
+    return $clean_html;
+}
+
+1;