Commit | Line | Data |
b616daaf |
1 | #!/usr/bin/perl -w |
b616daaf |
2 | # |
3 | # basic.t -- Basic tests for podlators. |
4 | # |
fe61459e |
5 | # Copyright 2001, 2002, 2004, 2006, 2009 by Russ Allbery <rra@stanford.edu> |
b616daaf |
6 | # |
7 | # This program is free software; you may redistribute it and/or modify it |
8 | # under the same terms as Perl itself. |
9 | |
10 | BEGIN { |
11 | chdir 't' if -d 't'; |
add0b696 |
12 | if ($ENV{PERL_CORE}) { |
b4558dc4 |
13 | @INC = '../lib'; |
add0b696 |
14 | } |
b4558dc4 |
15 | unshift (@INC, '../blib/lib'); |
b616daaf |
16 | $| = 1; |
b616daaf |
17 | } |
18 | |
fe61459e |
19 | use strict; |
b616daaf |
20 | |
fe61459e |
21 | use Test::More tests => 15; |
22 | |
23 | BEGIN { |
24 | use_ok ('Pod::Man'); |
25 | use_ok ('Pod::Text'); |
26 | use_ok ('Pod::Text::Overstrike'); |
27 | use_ok ('Pod::Text::Termcap'); |
28 | } |
b616daaf |
29 | |
b4558dc4 |
30 | # Find the path to the test source files. This requires some fiddling when |
31 | # these tests are run as part of Perl core. |
32 | sub source_path { |
33 | my $file = shift; |
34 | if ($ENV{PERL_CORE}) { |
35 | require File::Spec; |
36 | my $updir = File::Spec->updir; |
37 | my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 't'); |
38 | return File::Spec->catfile ($dir, $file); |
39 | } else { |
40 | return $file; |
41 | } |
42 | } |
43 | |
b616daaf |
44 | # Hard-code a few values to try to get reproducible results. |
b4558dc4 |
45 | $ENV{COLUMNS} = 80; |
6ce9a2f8 |
46 | $ENV{TERM} = 'xterm'; |
b4558dc4 |
47 | $ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m'; |
b616daaf |
48 | |
49 | # Map of translators to file extensions to find the formatted output to |
50 | # compare against. |
51 | my %translators = ('Pod::Man' => 'man', |
52 | 'Pod::Text' => 'txt', |
53 | 'Pod::Text::Color' => 'clr', |
54 | 'Pod::Text::Overstrike' => 'ovr', |
b4558dc4 |
55 | 'Pod::Text::Termcap' => 'cap'); |
b616daaf |
56 | |
57 | # Set default options to match those of pod2man and pod2text. |
fe61459e |
58 | our %options = (sentence => 0); |
b616daaf |
59 | |
fe61459e |
60 | for my $module (sort keys %translators) { |
61 | SKIP: { |
62 | if ($module eq 'Pod::Text::Color') { |
63 | eval { require Term::ANSIColor }; |
64 | skip 'Term::ANSIColor not found', 3 if $@; |
65 | require_ok ('Pod::Text::Color'); |
b7ae008f |
66 | } |
fe61459e |
67 | my $parser = $module->new (%options); |
68 | isa_ok ($parser, $module, 'Parser object'); |
b616daaf |
69 | |
fe61459e |
70 | # For Pod::Man, strip out the autogenerated header up to the .TH title |
71 | # line. That means that we don't check those things; oh well. The |
72 | # header changes with each version change or touch of the input file. |
73 | open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; |
74 | $parser->parse_from_file (source_path ('basic.pod'), \*OUT); |
75 | close OUT; |
76 | if ($module eq 'Pod::Man') { |
77 | open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; |
78 | open (OUTPUT, "> out.$translators{$module}") |
79 | or die "Cannot create out.$translators{$module}: $!\n"; |
80 | local $_; |
81 | while (<TMP>) { last if /^\.nh/ } |
82 | print OUTPUT while <TMP>; |
83 | close OUTPUT; |
84 | close TMP; |
85 | 1 while unlink 'out.tmp'; |
86 | } else { |
87 | rename ('out.tmp', "out.$translators{$module}") |
88 | or die "Cannot rename out.tmp: $!\n"; |
89 | } |
90 | |
91 | # Slurp the output and expected output and compare them. |
92 | my ($master, $output); |
93 | { |
94 | local $/; |
95 | open (MASTER, source_path ("basic.$translators{$module}")) |
96 | or die "Cannot open basic.$translators{$module}: $!\n"; |
97 | open (OUTPUT, "out.$translators{$module}") |
98 | or die "Cannot open out.$translators{$module}: $!\n"; |
99 | $master = <MASTER>; |
100 | $output = <OUTPUT>; |
101 | close MASTER; |
102 | close OUTPUT; |
103 | } |
6ce9a2f8 |
104 | |
11f72409 |
105 | # OS/390 is EBCDIC, which uses a different character for ESC |
6ce9a2f8 |
106 | # apparently. Try to convert so that the test still works. |
fe61459e |
107 | if ($^O eq 'os390' and $module eq 'Pod::Text::Termcap') { |
6ce9a2f8 |
108 | $output =~ tr/\033/\047/; |
109 | } |
fe61459e |
110 | if (ok ($master eq $output, "$module output is correct")) { |
111 | 1 while unlink "out.$translators{$module}"; |
b616daaf |
112 | } else { |
fe61459e |
113 | diag ("Non-matching output left in out.$translators{$module}\n"); |
b616daaf |
114 | } |
115 | } |
b616daaf |
116 | } |