git.maemo.org Git - dh-make-perl/blob - dev/i386/libhtml-tree-perl/libhtml-tree-perl-3.23/t/unicode.t

   1 #!perl -w
   2 # -*-Perl-*-
   3 # Time-stamp: "2003-09-15 01:45:14 ADT"
   4
   5 use strict;
   6 use Test::More;
   7 my $DEBUG = 2;
   8
   9 BEGIN {
  10   # Make sure we've got Unicode support:
  11   eval "use v5.8.0;  utf8::is_utf8('x');";
  12   if ($@) {
  13     plan skip_all => "Perl 5.8.0 or newer required for Unicode tests";
  14     exit;
  15   }
  16
  17   plan tests => 11;
  18   binmode STDOUT, ":utf8";
  19 } # end BEGIN
  20
  21 use Encode;
  22 use HTML::TreeBuilder;
  23
  24 print "#Using Encode version v", $Encode::VERSION || "?", "\n";
  25 print "#Using HTML::TreeBuilder version v$HTML::TreeBuilder::VERSION\n";
  26 print "#Using HTML::Element version v$HTML::Element::VERSION\n";
  27 print "#Using HTML::Parser version v", $HTML::Parser::VERSION || "?", "\n";
  28 print "#Using HTML::Entities version v", $HTML::Entities::VERSION || "?", "\n";
  29 print "#Using HTML::Tagset version v", $HTML::Tagset::VERSION || "?", "\n";
  30 print "# Running under perl version $] for $^O",
  31   (chr(65) eq 'A') ? "\n" : " in a non-ASCII world\n";
  32 print "# Win32::BuildNumber ", &Win32::BuildNumber(), "\n"
  33   if defined(&Win32::BuildNumber) and defined &Win32::BuildNumber();
  34 print "# MacPerl verison $MacPerl::Version\n"
  35   if defined $MacPerl::Version;
  36 printf
  37   "# Current time local: %s\n# Current time GMT:   %s\n",
  38   scalar(localtime($^T)), scalar(gmtime($^T));
  39
  40 ok 1;
  41
  42 ok same('<p>&nbsp;</p>', decode('latin1', "<p>\xA0</p>"));
  43
  44 ok !same('<p></p>',  decode('latin1', "<p>\xA0</p>"), 1);
  45 ok !same('<p> </p>', decode('latin1', "<p>\xA0</p>"), 1);
  46
  47 ok same('<p>&nbsp;&nbsp;&nbsp;</p>', decode('latin1', "<p>\xA0\xA0\xA0</p>"));
  48 ok same("<p>\xA0\xA0\xA0</p>",       decode('latin1', "<p>\xA0\xA0\xA0</p>"));
  49
  50 ok !same('<p></p>',  decode('latin1', "<p>\xA0\xA0\xA0</p>"), 1);
  51 ok !same('<p> </p>', decode('latin1', "<p>\xA0\xA0\xA0</p>"), 1);
  52
  53 ok same('<p>&nbsp;&nbsp;&mdash;&nbsp;&nbsp;</p>',
  54         "<p>\xA0\xA0\x{2014}\xA0\xA0</p>");
  55
  56 ok same('<p>&nbsp;&nbsp;XXmdashXX&nbsp;&nbsp;</p>',
  57         "<p>\xA0\xA0\x{2014}\xA0\xA0</p>",
  58         0, sub { $_[0] =~ s/XXmdashXX/\x{2014}/ });
  59
  60 ok same('<p>&nbsp;<b>bold</b>&nbsp;&nbsp;</p>',
  61         decode('latin1', "<p>\xA0<b>bold</b>\xA0\xA0</p>"));
  62
  63 sub same {
  64   my($code1, $code2, $flip, $fixup) = @_;
  65   my $t1 = HTML::TreeBuilder->new;
  66   my $t2 = HTML::TreeBuilder->new;
  67
  68   if(ref $code1) { $t1->implicit_tags(0); $code1 = $$code1 }
  69   if(ref $code2) { $t2->implicit_tags(0); $code2 = $$code2 }
  70
  71   $t1->parse($code1); $t1->eof;
  72   $t2->parse($code2); $t2->eof;
  73
  74   my $out1 = $t1->as_XML;
  75   my $out2 = $t2->as_XML;
  76
  77   $fixup->($out1, $out2) if $fixup;
  78
  79   my $rv = ($out1 eq $out2);
  80
  81   #print $rv? "RV TRUE\n" : "RV FALSE\n";
  82   #print $flip? "FLIP TRUE\n" : "FLIP FALSE\n";
  83
  84   if($flip ? (!$rv) : $rv) {
  85     if($DEBUG > 2) {
  86       print
  87         "In1 $code1\n",
  88         "In2 $code2\n",
  89         "Out1 $out1\n",
  90         "Out2 $out2\n",
  91         "\n\n";
  92     }
  93   } else {
  94     local $_;
  95     foreach my $line (
  96       '',
  97       "The following failure is at " . join(' : ' ,caller),
  98       "Explanation of failure: " . ($flip ? 'same' : 'different')
  99         . " parse trees!",
 100       sprintf("Input code 1 (utf8=%d):", utf8::is_utf8($code1)), $code1,
 101       sprintf("Input code 2 (utf8=%d):", utf8::is_utf8($code2)), $code2,
 102       "Output tree (as XML) 1:", $out1,
 103       "Output tree (as XML) 2:", $out2,
 104     ) {
 105       $_ = $line;
 106       s/\n/\n# /g;
 107       print "# $_\n";
 108     }
 109   }
 110
 111   $t1->delete;
 112   $t2->delete;
 113
 114   return $rv;
 115 } # end same