ext/Text-Tabs/t/fill.t

   1 #!/usr/bin/perl -w -I.
   2
   3 @tests = (split(/\nEND\n/s, <<DONE));
   4 TEST1
   5 Cyberdog Information
   6
   7 Cyberdog & Netscape in the news
   8 Important Press Release regarding Cyberdog and Netscape. Check it out!
   9
  10 Cyberdog Plug-in Support!
  11 Cyberdog support for Netscape Plug-ins is now available to download! Go
  12 to the Cyberdog Beta Download page and download it now!
  13
  14 Cyberdog Book
  15 Check out Jesse Feiler's way-cool book about Cyberdog. You can find
  16 details out about the book as well as ordering information at Philmont
  17 Software Mill site.
  18
  19 Java!
  20 Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and install
  21 the Mac OS Runtime for Java and try it out!
  22
  23 Cyberdog 1.1 Beta 3
  24 We hope that Cyberdog and OpenDoc 1.1 will be available within the next
  25 two weeks. In the meantime, we have released another version of
  26 Cyberdog, Cyberdog 1.1 Beta 3. This version fixes several bugs that were
  27 reported to us during out public beta period. You can check out our release
  28 notes to see what we fixed!
  29 END
  30     Cyberdog Information
  31     Cyberdog & Netscape in the news Important Press Release regarding
  32  Cyberdog and Netscape. Check it out!
  33     Cyberdog Plug-in Support! Cyberdog support for Netscape Plug-ins is now
  34  available to download! Go to the Cyberdog Beta Download page and download
  35  it now!
  36     Cyberdog Book Check out Jesse Feiler's way-cool book about Cyberdog.
  37  You can find details out about the book as well as ordering information at
  38  Philmont Software Mill site.
  39     Java! Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and
  40  install the Mac OS Runtime for Java and try it out!
  41     Cyberdog 1.1 Beta 3 We hope that Cyberdog and OpenDoc 1.1 will be
  42  available within the next two weeks. In the meantime, we have released
  43  another version of Cyberdog, Cyberdog 1.1 Beta 3. This version fixes
  44  several bugs that were reported to us during out public beta period. You
  45  can check out our release notes to see what we fixed!
  46 END
  47 DONE
  48
  49
  50 $| = 1;
  51
  52 print "1..";
  53 print @tests/2;
  54 print "\n";
  55
  56 use Text::Wrap;
  57
  58 $rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
  59
  60 $tn = 1;
  61 while (@tests) {
  62         my $in = shift(@tests);
  63         my $out = shift(@tests);
  64
  65         $in =~ s/^TEST(\d+)?\n//;
  66
  67         my $back = fill('    ', ' ', $in);
  68
  69         if ($back eq $out) {
  70                 print "ok $tn\n";
  71         } elsif ($rerun) {
  72                 my $oi = $in;
  73                 write_file("#o", $back);
  74                 write_file("#e", $out);
  75                 foreach ($in, $back, $out) {
  76                         s/\t/^I\t/gs;
  77                         s/\n/\$\n/gs;
  78                 }
  79                 print "------------ input ------------\n";
  80                 print $in;
  81                 print "\n------------ output -----------\n";
  82                 print $back;
  83                 print "\n------------ expected ---------\n";
  84                 print $out;
  85                 print "\n-------------------------------\n";
  86                 $Text::Wrap::debug = 1;
  87                 fill('    ', ' ', $oi);
  88                 exit(1);
  89         } else {
  90                 print "not ok $tn\n";
  91         }
  92         $tn++;
  93 }
  94
  95 sub write_file
  96 {
  97         my ($f, @data) = @_;
  98
  99         local(*F);
 100
 101         open(F, ">$f") || die "open >$f: $!";
 102         (print F @data) || die "write $f: $!";
 103         close(F) || die "close $f: $!";
 104         return 1;
 105 }