1 # (X)Emacs mode: -*- cperl -*-
5 =head1 Unit Test Package for Term::ProgressBar
7 This package tests the name functionality of Term::ProgressBar.
11 use Data::Dumper qw( Dumper );
12 use FindBin qw( $Bin );
13 use Test qw( ok plan );
16 use test qw( evcheck );
18 use constant MESSAGE1 => 'The Gospel of St. Jude';
19 use constant NAME1 => 'Algenon';
20 use constant NAME2 => 'Smegma';
23 # 1 for compilation test,
28 =head2 Test 1: compilation
30 This test confirms that the test script and the modules it calls compiled
35 use Term::ProgressBar;
37 ok 1, 1, 'compilation';
39 Term::ProgressBar->__force_term (50);
41 # -------------------------------------
43 =head2 Tests 2--10: Count 1-10
45 Create a progress bar with 10 things, and a name 'Algenon'.
46 Update it it from 1 to 10.
48 (1) Check no exception thrown on creation
49 (2) Check no exception thrown on update (1..3)
50 (3) Check bar number is 30%
51 (4) Check bar is 30% along
52 (5) Check no exception thrown on message send
53 (6) Check no exception thrown on update (6..10)
54 (7) Check message seen
55 (8) Check bar is complete
56 (9) Check bar number is 100%
60 use Capture::Tiny qw(capture);
64 my ($out, $err) = capture {
66 $p = Term::ProgressBar->new({count => 10, name => NAME1});
67 }, 'Count 1-10 ( 1)'),
68 1, 'Count 1-10 ( 1)');
69 ok (evcheck(sub { $p->update($_) for 1..3 }, 'Count 1-10 ( 2)'),
70 1, 'Count 1-10 ( 2)');
75 print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
77 my @lines = split /\n/, $err;
79 ok $lines[-1], qr/^@{[NAME1()]}: \s*\b30%/, 'Count 1-10 ( 3)';
80 my ($bar, $space) = $lines[-1] =~ /\[(=*)(\s*)\]/;
81 my $length = length($bar) + length($space);
83 ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
85 my $barexpect = $length * 0.3;
86 my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
89 ($out, $err) = capture {
91 ok (evcheck(sub { $p->message(MESSAGE1) }, 'Count 1-10 ( 5)'),
92 1, 'Count 1-10 ( 5)');
93 ok (evcheck(sub { $p->update($_) for 6..10 }, 'Count 1-10 ( 6)'),
94 1, 'Count 1-10 ( 6)');
99 print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
102 @lines = split /\n/, $err;
104 ok $lines[0], MESSAGE1, 'Count 1-10 ( 7)';
105 ok $lines[-1], qr/\[=+\]/, 'Count 1-10 ( 8)';
106 ok $lines[-1], qr/^@{[NAME1()]}: \s*100%/, 'Count 1-10 ( 9)';
109 # -------------------------------------
111 =head2 Tests 11--20: Count 1-20
113 Create a progress bar with 20 things, and a name 'Smegma'.
114 Update it it from 1 to 20.
117 (1) Check no exception thrown on creation
118 (2) Check no exception thrown on update (1..12)
119 (3) Check bar number is 60%
120 (4) Check bar is 60% along
121 (5) Check no exception thrown on message send
122 (6) Check no exception thrown on update (13..20)
123 (7) Check message seen
124 (8) Check bar is complete
125 (9) Check bar number is 100%
131 my ($out, $err) = capture {
132 ok (evcheck(sub { $p = Term::ProgressBar->new(NAME2, 10); },
134 1, 'Count 1-10 ( 1)');
135 ok (evcheck(sub { $p->update($_) for 1..3 }, 'Count 1-10 ( 2)'),
136 1, 'Count 1-10 ( 2)');
141 print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
143 my @lines = split /\n/, $err;
145 ok $lines[-1], qr/^@{[NAME2()]}: \s*\b30%/, 'Count 1-10 ( 3)';
146 my ($bar, $space) = $lines[-1] =~ /(\#*)(\s*)/;
147 my $length = length($bar) + length($space);
149 ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
151 my $barexpect = $length * 0.3;
152 my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
155 ($out, $err) = capture {
156 ok (evcheck(sub { $p->message(MESSAGE1) }, 'Count 1-10 ( 5)'),
157 1, 'Count 1-10 ( 5)');
158 ok (evcheck(sub { $p->update($_) for 6..10 }, 'Count 1-10 ( 6)'),
159 1, 'Count 1-10 ( 6)');
163 print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
166 @lines = split /\n/, $err;
168 ok $lines[-1], qr/^@{[NAME2()]}: \s*\d+% \#*$/, 'Count 1-10 ( 8)';
169 ok $lines[-1], qr/^@{[NAME2()]}: \s*100%/, 'Count 1-10 ( 9)';
172 # -------------------------------------