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 Test::More tests => 18;
15 use constant MESSAGE1 => 'The Gospel of St. Jude';
16 use constant NAME1 => 'Algenon';
17 use constant NAME2 => 'Smegma';
20 =head2 Test 1: compilation
22 This test confirms that the test script and the modules it calls compiled
27 use_ok 'Term::ProgressBar';
29 Term::ProgressBar->__force_term (50);
31 # -------------------------------------
33 =head2 Tests 2--10: Count 1-10
35 Create a progress bar with 10 things, and a name 'Algenon'.
36 Update it it from 1 to 10.
38 (1) Check no exception thrown on creation
39 (2) Check no exception thrown on update (1..3)
40 (3) Check bar number is 30%
41 (4) Check bar is 30% along
42 (5) Check no exception thrown on message send
43 (6) Check no exception thrown on update (6..10)
44 (7) Check message seen
45 (8) Check bar is complete
46 (9) Check bar number is 100%
50 use Capture::Tiny qw(capture);
54 my ($out, $err) = capture {
56 $p = Term::ProgressBar->new({count => 10, name => NAME1});
58 lives_ok { $p->update($_) for 1..3 } 'Count 1-10 ( 2)';
63 print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
65 my @lines = split /\n/, $err;
67 like $lines[-1], qr/^@{[NAME1()]}: \s*\b30%/, 'Count 1-10 ( 3)';
68 my ($bar, $space) = $lines[-1] =~ /\[(=*)(\s*)\]/;
69 my $length = length($bar) + length($space);
71 ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
73 my $barexpect = $length * 0.3;
74 my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
77 ($out, $err) = capture {
79 lives_ok { $p->message(MESSAGE1) } 'Count 1-10 ( 5)';
80 lives_ok { $p->update($_) for 6..10 } 'Count 1-10 ( 6)';
85 print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
88 @lines = split /\n/, $err;
90 is $lines[0], MESSAGE1, 'Count 1-10 ( 7)';
91 like $lines[-1], qr/\[=+\]/, 'Count 1-10 ( 8)';
92 like $lines[-1], qr/^@{[NAME1()]}: \s*100%/, 'Count 1-10 ( 9)';
95 # -------------------------------------
97 =head2 Tests 11--20: Count 1-20
99 Create a progress bar with 20 things, and a name 'Smegma'.
100 Update it it from 1 to 20.
103 (1) Check no exception thrown on creation
104 (2) Check no exception thrown on update (1..12)
105 (3) Check bar number is 60%
106 (4) Check bar is 60% along
107 (5) Check no exception thrown on message send
108 (6) Check no exception thrown on update (13..20)
109 (7) Check message seen
110 (8) Check bar is complete
111 (9) Check bar number is 100%
117 my ($out, $err) = capture {
118 lives_ok { $p = Term::ProgressBar->new(NAME2, 10); } 'Count 1-10 ( 1)';
119 lives_ok { $p->update($_) for 1..3 } 'Count 1-10 ( 2)';
124 print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
126 my @lines = split /\n/, $err;
128 like $lines[-1], qr/^@{[NAME2()]}: \s*\b30%/, 'Count 1-10 ( 3)';
129 my ($bar, $space) = $lines[-1] =~ /(\#*)(\s*)/;
130 my $length = length($bar) + length($space);
132 ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
134 my $barexpect = $length * 0.3;
135 my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
138 ($out, $err) = capture {
139 lives_ok { $p->message(MESSAGE1) } 'Count 1-10 ( 5)';
140 lives_ok { $p->update($_) for 6..10 } 'Count 1-10 ( 6)';
144 print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
147 @lines = split /\n/, $err;
149 like $lines[-1], qr/^@{[NAME2()]}: \s*\d+% \#*$/, 'Count 1-10 ( 8)';
150 like $lines[-1], qr/^@{[NAME2()]}: \s*100%/, 'Count 1-10 ( 9)';
153 # -------------------------------------