1N/A#!/usr/bin/perl -w
1N/A# $Id: text-errors.t,v 1.1 2002/01/01 02:41:53 eagle Exp $
1N/A#
1N/A# texterrs.t -- Error tests for Pod::Text.
1N/A#
1N/A# Copyright 2001 by Russ Allbery <rra@stanford.edu>
1N/A#
1N/A# This program is free software; you may redistribute it and/or modify it
1N/A# under the same terms as Perl itself.
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A if ($ENV{PERL_CORE}) {
1N/A @INC = '../lib';
1N/A } else {
1N/A unshift (@INC, '../blib/lib');
1N/A }
1N/A unshift (@INC, '../blib/lib');
1N/A $| = 1;
1N/A print "1..5\n";
1N/A}
1N/A
1N/AEND {
1N/A print "not ok 1\n" unless $loaded;
1N/A}
1N/A
1N/Ause Pod::Text;
1N/A
1N/A$loaded = 1;
1N/Aprint "ok 1\n";
1N/A
1N/A# Hard-code a few values to try to get reproducible results.
1N/A$ENV{COLUMNS} = 80;
1N/A$ENV{TERM} = 'xterm';
1N/A$ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m';
1N/A
1N/A# Set default options to match those of pod2man and pod2text.
1N/Amy %options = (sentence => 0);
1N/A
1N/A# Capture warnings for inspection.
1N/Amy $warnings = '';
1N/A$SIG{__WARN__} = sub { $warnings .= $_[0] };
1N/A
1N/A# Run a single test, given some POD to parse and the warning messages that are
1N/A# expected. Any formatted output is ignored; only warning messages are
1N/A# checked. Writes the POD to a temporary file since that's the easiest way to
1N/A# interact with Pod::Parser.
1N/Asub test_error {
1N/A my ($pod, $expected) = @_;
1N/A open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
1N/A print TMP $pod;
1N/A close TMP;
1N/A my $parser = Pod::Text->new (%options);
1N/A return unless $parser;
1N/A $warnings = '';
1N/A $parser->parse_from_file ('tmp.pod', 'out.tmp');
1N/A unlink ('tmp.pod', 'out.tmp');
1N/A if ($warnings eq $expected) {
1N/A return 1;
1N/A } else {
1N/A print " # '$warnings'\n # '$expected'\n";
1N/A return 0;
1N/A }
1N/A}
1N/A
1N/A# The actual tests.
1N/Amy @tests = (
1N/A [ "=head1 a E<0x2028> b\n"
1N/A => "tmp.pod:1: Unknown escape: E<0x2028>\n" ],
1N/A [ "=head1 a Y<0x2028> b\n"
1N/A => "tmp.pod:1: Unknown formatting code: Y<0x2028>\n" ],
1N/A [ "=head1 TEST\n\n=command args\n"
1N/A => "tmp.pod:3: Unknown command paragraph: =command args\n" ],
1N/A [ "=head1 TEST\n\n Foo bar\n\n=back\n"
1N/A => "tmp.pod:5: Unmatched =back\n" ]
1N/A);
1N/Amy $n = 2;
1N/Afor (@tests) {
1N/A print (test_error ($$_[0], $$_[1]) ? "ok $n\n" : "not ok $n\n");
1N/A $n++;
1N/A}