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::More tests => 18;
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 =head2 Test 1: compilation
25 This test confirms that the test script and the modules it calls compiled
30 use_ok 'Term::ProgressBar';
32 Term::ProgressBar->__force_term (50);
34 # -------------------------------------
36 =head2 Tests 2--10: Count 1-10
38 Create a progress bar with 10 things, and a name 'Algenon'.
39 Update it it from 1 to 10.
41 (1) Check no exception thrown on creation
42 (2) Check no exception thrown on update (1..3)
43 (3) Check bar number is 30%
44 (4) Check bar is 30% along
45 (5) Check no exception thrown on message send
46 (6) Check no exception thrown on update (6..10)
47 (7) Check message seen
48 (8) Check bar is complete
49 (9) Check bar number is 100%
53 use Capture::Tiny qw(capture);
57 my ($out, $err) = capture {
59 $p = Term::ProgressBar->new({count => 10, name => NAME1});
60 }, 'Count 1-10 ( 1)'),
62 ok (evcheck(sub { $p->update($_) for 1..3 }, 'Count 1-10 ( 2)'),
68 print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
70 my @lines = split /\n/, $err;
72 like $lines[-1], qr/^@{[NAME1()]}: \s*\b30%/, 'Count 1-10 ( 3)';
73 my ($bar, $space) = $lines[-1] =~ /\[(=*)(\s*)\]/;
74 my $length = length($bar) + length($space);
76 ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
78 my $barexpect = $length * 0.3;
79 my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
82 ($out, $err) = capture {
84 ok (evcheck(sub { $p->message(MESSAGE1) }, 'Count 1-10 ( 5)'),
86 ok (evcheck(sub { $p->update($_) for 6..10 }, 'Count 1-10 ( 6)'),
92 print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
95 @lines = split /\n/, $err;
97 is $lines[0], MESSAGE1, 'Count 1-10 ( 7)';
98 like $lines[-1], qr/\[=+\]/, 'Count 1-10 ( 8)';
99 like $lines[-1], qr/^@{[NAME1()]}: \s*100%/, 'Count 1-10 ( 9)';
102 # -------------------------------------
104 =head2 Tests 11--20: Count 1-20
106 Create a progress bar with 20 things, and a name 'Smegma'.
107 Update it it from 1 to 20.
110 (1) Check no exception thrown on creation
111 (2) Check no exception thrown on update (1..12)
112 (3) Check bar number is 60%
113 (4) Check bar is 60% along
114 (5) Check no exception thrown on message send
115 (6) Check no exception thrown on update (13..20)
116 (7) Check message seen
117 (8) Check bar is complete
118 (9) Check bar number is 100%
124 my ($out, $err) = capture {
125 ok (evcheck(sub { $p = Term::ProgressBar->new(NAME2, 10); },
128 ok (evcheck(sub { $p->update($_) for 1..3 }, 'Count 1-10 ( 2)'),
134 print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
136 my @lines = split /\n/, $err;
138 like $lines[-1], qr/^@{[NAME2()]}: \s*\b30%/, 'Count 1-10 ( 3)';
139 my ($bar, $space) = $lines[-1] =~ /(\#*)(\s*)/;
140 my $length = length($bar) + length($space);
142 ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
144 my $barexpect = $length * 0.3;
145 my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
148 ($out, $err) = capture {
149 ok (evcheck(sub { $p->message(MESSAGE1) }, 'Count 1-10 ( 5)'),
151 ok (evcheck(sub { $p->update($_) for 6..10 }, 'Count 1-10 ( 6)'),
156 print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
159 @lines = split /\n/, $err;
161 like $lines[-1], qr/^@{[NAME2()]}: \s*\d+% \#*$/, 'Count 1-10 ( 8)';
162 like $lines[-1], qr/^@{[NAME2()]}: \s*100%/, 'Count 1-10 ( 9)';
165 # -------------------------------------