use strict; use warnings;
use Test;
my $n_tests;
BEGIN { $n_tests = 0 }
use Text::Table;
print "# Version: $Text::Table::VERSION\n";
# internal parser functions
# undefined argument
BEGIN { $n_tests += 6 }
my $spec = Text::Table::_parse_spec();
ok( scalar @{ $spec->{ title}}, 0);
ok( $spec->{ align}, 'auto');
ok( scalar @{ $spec->{ sample}}, 0);
$spec = Text::Table::_parse_spec( undef);
ok( scalar @{ $spec->{ title}}, 0);
ok( $spec->{ align}, 'auto');
ok( scalar @{ $spec->{ sample}}, 0);
# other functions
use constant T_EMPTY => <<EOT1;
EOT1
use constant T_SINGLE => <<EOT2;
single line title
EOT2
use constant T_MULTI => <<EOT3;
multi-line
<not the alignment>
title
EOT3
use constant S_EMPTY => <<EOS1;
&
EOS1
use constant S_SINGLE => <<EOS2;
&num(,)
00.000
EOS2
use constant S_MULTI => <<EOS3;
&
xxxx
0.1
EOS3
use constant TITLES => ( T_EMPTY, T_SINGLE, T_MULTI);
use constant TITLE_ANS => map { chomp; $_} TITLES;
use constant SAMPLES => ( S_EMPTY, S_SINGLE, S_MULTI);
use constant SAMPLE_ANS => ( "", "00.000", "xxxx\n0.1\n");
use constant ALIGN_ANS => ( "auto", "num(,)", "auto");
BEGIN {
my $n_titles = @{ [ TITLES]};
my $n_samples = @{ [ SAMPLES]};
$n_tests += 2*$n_titles;
$n_tests += 3*$n_samples;
$n_tests += 2*3*$n_titles*$n_samples;
}
my @title_ans = TITLE_ANS;
for my $title ( TITLES ) {
$title .= "&" if $title =~ /^&/m;
my $spec = Text::Table::_parse_spec( $title);
ok( join( "\n", @{ $spec->{ title}}), shift @title_ans);
ok( join( "\n", @{ $spec->{ sample}}), '');
}
my @sample_ans = SAMPLE_ANS;
my @align_ans = ALIGN_ANS;
for my $sample ( SAMPLES ) {
my $spec = Text::Table::_parse_spec( $sample);
ok( join( "\n", @{ $spec->{ title}}), '');
ok( join( "\n", @{ $spec->{ sample}}), shift @sample_ans);
ok( $spec->{ align}, shift @align_ans);
}
@title_ans = TITLE_ANS;
for my $title ( TITLES ) {
my $title_ans = shift @title_ans;
my @sample_ans = SAMPLE_ANS;
my @align_ans = ALIGN_ANS;
for my $sample ( SAMPLES ) {
my $spec = Text::Table::_parse_spec( "$title$sample");
ok( join( "\n", @{ $spec->{ title}}), $title_ans);
ok( join( "\n", @{ $spec->{ sample}}), shift @sample_ans);
ok( join( "\n", $spec->{ align}), shift @align_ans);
}
@sample_ans = SAMPLE_ANS;
@align_ans = ALIGN_ANS;
chomp $title;
for my $sample ( SAMPLES ) {
chomp $sample;
chomp( my $sample_ans = shift @sample_ans);
my $spec = Text::Table::_parse_spec( "$title\n$sample");
ok( join( "\n", @{ $spec->{ title}}), $title_ans);
ok( join( "\n", @{ $spec->{ sample}}), $sample_ans);
ok( join( "\n", $spec->{ align}), shift @align_ans);
}
}
# functions with empty table
BEGIN { $n_tests += 5 }
my $tb;
$tb = Text::Table->new;
ok( ref $tb, 'Text::Table');
ok( $tb->n_cols, 0);
ok( $tb->height, 0);
ok( $tb->width, 0);
ok( $tb->stringify, '');
# empty table with non-empty data array (auto-initialisation)
BEGIN { $n_tests += 4 }
$tb->load(
'1 2 3',
[4, 5, 6],
'7 8',
);
ok( $tb->n_cols, 3);
ok( $tb->height, 3);
ok( $tb->width, 5);
ok( $tb->stringify, "1 2 3\n4 5 6\n7 8 \n");
# run this again with undefined $/, see if there's a warning
BEGIN { $n_tests += 1 }
{
local $/;
my $warncount = 0;
local $SIG{__WARN__} = sub { ++ $warncount };
$tb = Text::Table->new;
$tb->load(
'1 2 3',
[4, 5, 6],
'7 8',
);
ok($warncount, 0);
}
# single title-less column
BEGIN { $n_tests += 4 }
$tb = Text::Table->new( '');
ok( $tb->n_cols, 1);
ok( $tb->height, 0);
ok( $tb->width, 0);
ok( $tb->stringify, '');
# same with some data (more than needed, actually)
BEGIN { $n_tests += 8 }
$tb->load(
"1 2 3",
[4, 5, 6],
[7, 8],
);
ok( $tb->n_cols, 1);
ok( $tb->height, 3);
ok( $tb->width, 1);
ok( $tb->stringify, "1\n4\n7\n");
$tb->clear;
ok( $tb->n_cols, 1);
ok( $tb->height, 0);
ok( $tb->width, 0);
ok( $tb->stringify, '');
# do samples work?
BEGIN { $n_tests += 5 }
$tb = Text::Table->new( { sample => 'xxxx'});
$tb->load( '0');
ok( $tb->width, 4);
ok( $tb->height, 1);
$tb->load( '12345');
ok( $tb->width, 5);
ok( $tb->height, 2);
# samples should be considered in title alignment even with no data
my $tit;
$tb = Text::Table->new( { title => 'x', sample => 'xxx'});
chomp( $tit = $tb->title( 0));
ok( $tit, 'x ');
# load without data
$tb = Text::Table->new();
BEGIN { $n_tests += 2 }
{
my $warncount = 0;
local $SIG{__WARN__} = sub { ++ $warncount };
$tb->load();
ok($warncount, 0);
$tb->load([]);
ok($warncount, 0);
}
# overall functional check with typical table
use constant TYP_TITLE =>
{ title => 'name', align => 'left'},
{ title => 'age'},
"salary\n in \$",
"gibsnich",
;
use constant TYP_DATA =>
[ qw( fred 28 1256)],
"mary_anne 34 445.02",
[ qw( scroogy 87 356.10)],
"frosty 16 9999.9",
;
use constant TYP_TITLE_ANS => <<'EOT';
name age salary gibsnich
in $
EOT
use constant TYP_BODY_ANS => <<'EOT';
fred 28 1256
mary_anne 34 445.02
scroogy 87 356.10
frosty 16 9999.9
EOT
use constant TYP_ANS => TYP_TITLE_ANS . TYP_BODY_ANS;
BEGIN { $n_tests += 3 }
$tb = Text::Table->new( TYP_TITLE);
ok( $tb->n_cols, 4);
ok( $tb->height, 2);
ok( $tb->width, 24);
BEGIN { $n_tests += 4 }
$tb->load( TYP_DATA);
ok( $tb->n_cols, 4);
ok( $tb->height, 6);
ok( $tb->width, 30);
ok( $tb->stringify, TYP_ANS);
BEGIN { $n_tests += 3 }
$tb->clear;
ok( $tb->n_cols, 4);
ok( $tb->height, 2);
ok( $tb->width, 24);
# access parts of table
BEGIN { $n_tests += 8 }
$tb->load( TYP_DATA);
ok( join( '', $tb->title), TYP_TITLE_ANS);
ok( join( '', $tb->body), TYP_BODY_ANS);
my ( $first_title, $last_title) = ( TYP_TITLE_ANS =~ /(.*\n)/g)[ 0, -1];
my ( $first_body, $last_body) = ( TYP_BODY_ANS =~ /(.*\n)/g)[ 0, -1];
ok( ($tb->title( 0))[ 0], $first_title);
ok( ($tb->body( 0))[ 0], $first_body);
ok( ($tb->table( 0))[ 0], $first_title);
ok( ($tb->title( -1))[ 0], $last_title);
ok( ($tb->body( -1))[ 0], $last_body);
ok( ($tb->table( -1))[ 0], $last_body);
### separators and rules
BEGIN { $n_tests += 7 }
$tb = Text::Table->new( 'aaa', \' x ', 'bbb');
ok( $tb->rule, " x \n");
ok( $tb->rule( '=' ), "====x====\n");
ok( $tb->rule( '=', '+'), "====+====\n");
$tb->add( 'tttttt', '');
ok( $tb->rule, " x \n");
# multiple separators
$tb = Text::Table->new( 'aaa', \' xxxxx ', \' y ', 'bbb');
ok( $tb->rule, " y \n");
# different separators in head and body
$tb = Text::Table->new( 'aaa', \"x\ny", 'bbb');
ok( $tb->rule, " x \n");
ok( $tb->body_rule, " y \n");
### colrange
BEGIN { $n_tests += 16 }
$tb = Text::Table->new( 'aaa', \"|", 'bbb');
ok( ($tb->colrange( 0))[ 0], 0);
ok( ($tb->colrange( 0))[ 1], 3);
ok( ($tb->colrange( 1))[ 0], 4);
ok( ($tb->colrange( 1))[ 1], 3);
ok( ($tb->colrange( 2))[ 0], 7);
ok( ($tb->colrange( 2))[ 1], 0);
ok( ($tb->colrange( 9))[ 0], 7);
ok( ($tb->colrange( 9))[ 1], 0);
ok( ($tb->colrange( -1))[ 0], 4);
ok( ($tb->colrange( -1))[ 1], 3);
$tb->add( 'xxxxxx', 'yy');
ok( ($tb->colrange( 0))[ 0], 0);
ok( ($tb->colrange( 0))[ 1], 6);
ok( ($tb->colrange( 1))[ 0], 7);
ok( ($tb->colrange( 1))[ 1], 3);
ok( ($tb->colrange( 2))[ 0], 10);
ok( ($tb->colrange( 2))[ 1], 0);
# body-title alignment
BEGIN { $n_tests += 4 }
$tb = Text::Table->new( { title => 'x', align_title => 'right' });
$tb->add( 'xxx');
chomp( $tit = $tb->title( 0));
ok( $tit, ' x');
$tb = Text::Table->new( { title => 'x', align_title => 'center' });
$tb->add( 'xxx');
chomp( $tit = $tb->title( 0));
ok( $tit, ' x ');
$tb = Text::Table->new( { title => 'x', align_title => 'left' });
$tb->add( 'xxx');
chomp( $tit = $tb->title( 0));
ok( $tit, 'x ');
$tb = Text::Table->new( { title => 'x' }); # default?
$tb->add( 'xxx');
chomp( $tit = $tb->title( 0));
ok( $tit, 'x ');
# title-internal alignment
BEGIN { $n_tests += 5 }
$tb = Text::Table->new( { title => "x\nxxx", align_title_lines => 'right'});
chomp( ( $tit) = $tb->title); # first line
ok( $tit, ' x');
$tb = Text::Table->new( { title => "x\nxxx", align_title_lines => 'center'});
chomp( ( $tit) = $tb->title); # first line
ok( $tit, ' x ');
$tb = Text::Table->new( { title => "x\nxxx", align_title_lines => 'left'});
chomp( ( $tit) = $tb->title); # first line
ok( $tit, 'x ');
# default?
$tb = Text::Table->new( { title => "x\nxxx"});
chomp( ( $tit) = $tb->title); # first line
ok( $tit, 'x ');
# default propagation from 'align_title'
$tb = Text::Table->new( { title => "x\nxxx", align_title => 'right'});
chomp( ( $tit) = $tb->title);
ok( $tit, ' x');
### column selection
BEGIN { $n_tests += 5 }
$tb = Text::Table->new( '', '');
$tb->load( [ 0, 1], [ undef, 2], [ '', 3]);
ok( $tb->select( 0, 1 )->n_cols, 2);
ok( $tb->select( [ 0], 1 )->n_cols, 1);
ok( $tb->select( 0, [ 1])->n_cols, 2);
ok( $tb->select( [ 0], [ 1])->n_cols, 1);
ok( $tb->select( [ 0, 1])->n_cols, 0);
# multiple selection
BEGIN { $n_tests += 3 }
my $mult = $tb->select( 0, 1, 0, 1);
ok( $mult->n_cols, 4);
ok( $mult->height, 3);
ok( $mult->stringify, <<EOT);
0 1 0 1
2 2
3 3
EOT
# overloading
BEGIN { $n_tests += 1 }
$tb = Text::Table->new( TYP_TITLE);
$tb->load( TYP_DATA);
ok( "$tb", TYP_ANS);
# multi-line rows
BEGIN { $n_tests += 1 }
$tb = Text::Table->new( qw( A B C ) );
$tb->load( [ "1", "2", "3" ],
[ "a\nb", "c", "d" ],
[ "e", "f\ng", "h" ],
[ "i", "j", "k\nl" ],
[ "m", "n", "o" ] );
ok( "$tb", <<EOT);
A B C
1 2 3
a c d
b
e f h
g
i j k
l
m n o
EOT
# Chained ->load call
BEGIN { $n_tests += 1 }
ok( "" . Text::Table
-> new( TYP_TITLE )
-> load( TYP_DATA ),
TYP_ANS );
# Chained ->add call
BEGIN { $n_tests += 1 }
ok( "" . Text::Table
-> new( "x" x 10 )
-> add( "y" x 10 ),
"x" x 10 . "\n" . "y" x 10 . "\n");
BEGIN { plan tests => $n_tests }