1use Test::More; 2use strict; 3use warnings; 4 5{ 6package Local::ToMan; 7use parent 'Pod::Perldoc::ToMan'; 8use vars qw( $stty_text $is_linux $warning ); 9no warnings 'redefine'; 10no strict 'refs'; 11sub _get_stty { $stty_text } 12sub is_linux { $is_linux } 13sub warn { shift; $warning = join '', @_ } 14} 15 16BEGIN { 17our @columns = qw( EXPECTED IS_LINUX MANWIDTH MANWIDTH_EXPECTED STTY STTY_EXPECTED ); 18foreach my $i ( 0 .. $#columns ) { 19 no strict 'refs'; 20 *{"$columns[$i]"} = sub () { $i }; 21 } 22} 23 24my @tests = ( 25 # for linux, choose between manwidth and stty 26 [ 62, 1, undef, 0, "; 62 columns;", 62 ], 27 [ 63, 1, undef, 0, "columns 63", 63 ], 28 [ 57, 1, 57, 57, "columns 63", 63 ], 29 [ 73, 1, undef, 0, " ", 0 ], 30 31 # for not linux, the same 32 [ 62, 0, undef, 0, "; 62 columns;", 62 ], 33 [ 63, 0, undef, 0, "columns 63", 63 ], 34 [ 57, 0, 57, 57, "columns 63", 63 ], 35 [ 73, 0, undef, 0, " ", 0 ], 36 37 # bad manwidths 38 [ 62, 1, -1, 0, "; 62 columns;", 62 ], 39 [ 63, 1, 'abc', 0, "columns 63", 63 ], 40 [ 64, 1, '', 0, "columns 64", 64 ], 41 [ 73, 1, undef, 0, " ", 0 ], 42 ); 43 44plan tests => 3 * @tests; 45 46 47foreach my $test ( @tests ) { 48 local $ENV{MANWIDTH} = $test->[MANWIDTH]; 49 local $Local::ToMan::stty_text = $test->[STTY]; 50 local $Local::ToMan::is_linux = $test->[IS_LINUX]; 51 52 { 53 no warnings 'uninitialized'; 54 diag( sprintf 55 "MANWIDTH: %s STTY: %s LINUX: %s", 56 defined $ENV{MANWIDTH} ? $ENV{MANWIDTH} : "(undef)", 57 $Local::ToMan::stty_text, 58 $Local::ToMan::is_linux, 59 ) if $ENV{PERLDOCDEBUG}; 60 } 61 62 is( Local::ToMan->_get_columns_from_manwidth(), $test->[MANWIDTH_EXPECTED], 63 "_get_columns_from_manwidth returns the right number" ); 64 is( Local::ToMan->_get_columns_from_stty(), $test->[STTY_EXPECTED], 65 "_get_columns_from_stty returns the right number" ); 66 is( Local::ToMan->_get_columns, $test->[EXPECTED], 67 "_get_columns returns the right number" ); 68 } 69