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} 82