This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Pod::Html - correctly link to =item's on the same page
[perl5.git] / lib / Pod / t / text-errors.t
CommitLineData
2da3dd12
AMS
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
11BEGIN {
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
23END {
24 print "not ok 1\n" unless $loaded;
25}
26
27use Pod::Text;
28
29$loaded = 1;
30print "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.
38my %options = (sentence => 0);
39
40# Capture warnings for inspection.
41my $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.
48sub 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.
67my @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);
77my $n = 2;
78for (@tests) {
79 print (test_error ($$_[0], $$_[1]) ? "ok $n\n" : "not ok $n\n");
80 $n++;
81}