← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/horae/gutsy

« back to all changes in this revision

Viewing changes to 0CPAN/Pod-Simple-3.03/t/render.t

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2006-12-28 12:36:48 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20061228123648-9xnjr76wfthd92cq
Tags: 064-1
New upstream release, dropped dependency on libtk-filedialog-perl.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/Pod-Simple-3.03/t/render.t
1
 
 
2
 
use strict;
3
 
use Test;
4
 
BEGIN { plan tests => 26 };
5
 
use Pod::Simple::TextContent;
6
 
use Pod::Simple::Text;
7
 
 
8
 
BEGIN {
9
 
  *mytime = defined(&Win32::GetTickCount)
10
 
    ? sub () {Win32::GetTickCount() / 1000}
11
 
    : sub () {time()}
12
 
}
13
 
 
14
 
$Pod::Simple::Text::FREAKYMODE = 1;
15
 
use Pod::Simple::TiedOutFH ();
16
 
 
17
 
my $outfile = '10000';
18
 
 
19
 
chdir "t" or die "Can't chdir: $!" if -e "t";
20
 
 
21
 
 
22
 
foreach my $file (
23
 
  "test_junk1.pod",
24
 
  "test_junk2.pod",
25
 
  "test_old_perlcygwin.pod",
26
 
  "test_old_perlfaq3.pod",
27
 
  "test_old_perlvar.pod",
28
 
) {
29
 
 
30
 
  unless(-e $file) {
31
 
    ok 0;
32
 
    print "# But $file doesn't exist!!\n";
33
 
    exit 1;
34
 
  }
35
 
 
36
 
  my @out;
37
 
  my $precooked = $file;
38
 
  $precooked =~ s<\.pod><_out.txt>s;
39
 
  unless(-e $precooked) {
40
 
    ok 0;
41
 
    print "# But $precooked doesn't exist!!\n";
42
 
    exit 1;
43
 
  }
44
 
  
45
 
  print "#\n#\n#\n###################\n# $file\n";
46
 
  foreach my $class ('Pod::Simple::TextContent', 'Pod::Simple::Text') {
47
 
    my $p = $class->new;
48
 
    push @out, '';
49
 
    $p->output_string(\$out[-1]);
50
 
    my $t = mytime();
51
 
    $p->parse_file($file);
52
 
    printf "# %s %s %sb, %.03fs\n",
53
 
     ref($p), $file, length($out[-1]), mytime() - $t ;
54
 
    ok 1;
55
 
  }
56
 
 
57
 
  print "# Reading $precooked...\n";
58
 
  open(IN, $precooked) or die "Can't read-open $precooked: $!";
59
 
  {
60
 
    local $/;
61
 
    push @out, <IN>;
62
 
  }
63
 
  close(IN);
64
 
  print "#   ", length($out[-1]), " bytes pulled in.\n";
65
 
  
66
 
 
67
 
  for (@out) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; }
68
 
 
69
 
  my $faily = 0;
70
 
  print "#\n#Now comparing 1 and 2...\n";
71
 
  $faily += compare2($out[0], $out[1]);
72
 
  print "#\n#Now comparing 2 and 3...\n";
73
 
  $faily += compare2($out[1], $out[2]);
74
 
  print "#\n#Now comparing 1 and 3...\n";
75
 
  $faily += compare2($out[0], $out[2]);
76
 
 
77
 
  if($faily) {
78
 
    ++$outfile;
79
 
    
80
 
    my @outnames = map $outfile . $_ , qw(0 1);
81
 
    open(OUT2, ">$outnames[0].~out.txt") || die "Can't write-open $outnames[0].txt: $!";
82
 
 
83
 
    foreach my $out (@out) { push @outnames, $outnames[-1];  ++$outnames[-1] };
84
 
    pop @outnames;
85
 
    printf "# Writing to %s.txt .. %s.txt\n", $outnames[0], $outnames[-1];
86
 
    shift @outnames;
87
 
    
88
 
    binmode(OUT2);
89
 
    foreach my $out (@out) {
90
 
      my $outname = shift @outnames;
91
 
      open(OUT, ">$outname.txt") || die "Can't write-open $outname.txt: $!";
92
 
      binmode(OUT);
93
 
      print OUT  $out, "\n";
94
 
      print OUT2 $out, "\n";
95
 
      close(OUT);
96
 
    }
97
 
    close(OUT2);
98
 
  }
99
 
}
100
 
 
101
 
print "# Wrapping up... one for the road...\n";
102
 
ok 1;
103
 
print "# --- Done with ", __FILE__, " --- \n";
104
 
exit;
105
 
 
106
 
 
107
 
sub compare2 {
108
 
  my @out = @_;
109
 
  if($out[0] eq $out[1]) {
110
 
    ok 1;
111
 
    return 0;
112
 
  } elsif( do{
113
 
    for ($out[0], $out[1]) { tr/ //d; };
114
 
    $out[0] eq $out[1];
115
 
  }){
116
 
    print "# Differ only in whitespace.\n";
117
 
    ok 1;
118
 
    return 0;
119
 
  } else {
120
 
    #ok $out[0], $out[1];
121
 
    
122
 
    my $x = $out[0] ^ $out[1];
123
 
    $x =~ m/^(\x00*)/s or die;
124
 
    my $at = length($1);
125
 
    print "# Difference at byte $at...\n";
126
 
    if($at > 10) {
127
 
      $at -= 5;
128
 
    }
129
 
    {
130
 
      print "# ", substr($out[0],$at,20), "\n";
131
 
      print "# ", substr($out[1],$at,20), "\n";
132
 
      print "#      ^...";
133
 
    }
134
 
    
135
 
    
136
 
    
137
 
    ok 0;
138
 
    printf "# Unequal lengths %s and %s\n", length($out[0]), length($out[1]);
139
 
    return 1;
140
 
  }
141
 
}
142
 
 
143
 
 
144
 
__END__
145