lib/Pod/t/text-errors.t

   1 #!/usr/bin/perl -w
   2 # $Id: text-errors.t,v 1.1 2002/01/01 02:41:53 eagle Exp $
   3 #
   4 # texterrs.t -- Error tests for Pod::Text.
   5 #
   6 # Copyright 2001 by Russ Allbery <rra@stanford.edu>
   7 #
   8 # This program is free software; you may redistribute it and/or modify it
   9 # under the same terms as Perl itself.
  10
  11 BEGIN {
  12     chdir 't' if -d 't';
  13     if ($ENV{PERL_CORE}) {
  14         @INC = '../lib';
  15     } else {
  16         unshift (@INC, '../blib/lib');
  17     }
  18     unshift (@INC, '../blib/lib');
  19     $| = 1;
  20     print "1..5\n";
  21 }
  22
  23 END {
  24     print "not ok 1\n" unless $loaded;
  25 }
  26
  27 use Pod::Text;
  28
  29 $loaded = 1;
  30 print "ok 1\n";
  31
  32 # Hard-code a few values to try to get reproducible results.
  33 $ENV{COLUMNS} = 80;
  34 $ENV{TERM} = 'xterm';
  35 $ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m';
  36
  37 # Set default options to match those of pod2man and pod2text.
  38 my %options = (sentence => 0);
  39
  40 # Capture warnings for inspection.
  41 my $warnings = '';
  42 $SIG{__WARN__} = sub { $warnings .= $_[0] };
  43
  44 # Run a single test, given some POD to parse and the warning messages that are
  45 # expected.  Any formatted output is ignored; only warning messages are
  46 # checked.  Writes the POD to a temporary file since that's the easiest way to
  47 # interact with Pod::Parser.
  48 sub test_error {
  49     my ($pod, $expected) = @_;
  50     open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
  51     print TMP $pod;
  52     close TMP;
  53     my $parser = Pod::Text->new (%options);
  54     return unless $parser;
  55     $warnings = '';
  56     $parser->parse_from_file ('tmp.pod', 'out.tmp');
  57     unlink ('tmp.pod', 'out.tmp');
  58     if ($warnings eq $expected) {
  59         return 1;
  60     } else {
  61         print "  # '$warnings'\n  # '$expected'\n";
  62         return 0;
  63     }
  64 }
  65
  66 # The actual tests.
  67 my @tests = (
  68     [ "=head1 a E<0x2028> b\n"
  69         => "tmp.pod:1: Unknown escape: E<0x2028>\n" ],
  70     [ "=head1 a Y<0x2028> b\n"
  71         => "tmp.pod:1: Unknown formatting code: Y<0x2028>\n" ],
  72     [ "=head1 TEST\n\n=command args\n"
  73         => "tmp.pod:3: Unknown command paragraph: =command args\n" ],
  74     [ "=head1 TEST\n\n  Foo bar\n\n=back\n"
  75         => "tmp.pod:5: Unmatched =back\n" ]
  76 );
  77 my $n = 2;
  78 for (@tests) {
  79     print (test_error ($$_[0], $$_[1]) ? "ok $n\n" : "not ok $n\n");
  80     $n++;
  81 }