t/name.t

   1 # (X)Emacs mode: -*- cperl -*-
   2
   3 use strict;
   4
   5 =head1 Unit Test Package for Term::ProgressBar
   6
   7 This package tests the name functionality of Term::ProgressBar.
   8
   9 =cut
  10
  11 use Data::Dumper  qw( Dumper );
  12 use FindBin       qw( $Bin );
  13 use Test::More tests => 18;
  14
  15 use lib $Bin;
  16 use test qw( evcheck );
  17
  18 use constant MESSAGE1 => 'The Gospel of St. Jude';
  19 use constant NAME1    => 'Algenon';
  20 use constant NAME2    => 'Smegma';
  21
  22
  23 =head2 Test 1: compilation
  24
  25 This test confirms that the test script and the modules it calls compiled
  26 successfully.
  27
  28 =cut
  29
  30 use_ok 'Term::ProgressBar';
  31
  32 Term::ProgressBar->__force_term (50);
  33
  34 # -------------------------------------
  35
  36 =head2 Tests 2--10: Count 1-10
  37
  38 Create a progress bar with 10 things, and a name 'Algenon'.
  39 Update it it from 1 to 10.
  40
  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%
  50
  51 =cut
  52
  53 use Capture::Tiny qw(capture);
  54
  55 {
  56   my $p;
  57 my ($out, $err) = capture {
  58   ok (evcheck(sub {
  59                 $p = Term::ProgressBar->new({count => 10, name => NAME1});
  60               },                                            'Count 1-10 ( 1)'),
  61                                                           'Count 1-10 ( 1)');
  62   ok (evcheck(sub { $p->update($_) for 1..3  },             'Count 1-10 ( 2)'),
  63                                                           'Count 1-10 ( 2)');
  64 };
  65 print $out;
  66
  67   $err =~ s!^.*\r!!gm;
  68   print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
  69     if $ENV{TEST_DEBUG};
  70   my @lines = split /\n/, $err;
  71
  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);
  75   print STDERR
  76     ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
  77     if $ENV{TEST_DEBUG};
  78   my $barexpect = $length * 0.3;
  79   my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
  80   ok $ok;
  81
  82 ($out, $err) = capture {
  83
  84   ok (evcheck(sub { $p->message(MESSAGE1)    },             'Count 1-10 ( 5)'),
  85                                                           'Count 1-10 ( 5)');
  86   ok (evcheck(sub { $p->update($_) for 6..10 },             'Count 1-10 ( 6)'),
  87                                                           'Count 1-10 ( 6)');
  88 };
  89 print $out;
  90
  91   $err =~ s!^.*\r!!gm;
  92   print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
  93     if $ENV{TEST_DEBUG};
  94
  95   @lines = split /\n/, $err;
  96
  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)';
 100 }
 101
 102 # -------------------------------------
 103
 104 =head2 Tests 11--20: Count 1-20
 105
 106 Create a progress bar with 20 things, and a name 'Smegma'.
 107 Update it it from 1 to 20.
 108 Use v1 mode
 109
 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%
 119
 120 =cut
 121
 122 {
 123   my $p;
 124 my ($out, $err) = capture {
 125   ok (evcheck(sub { $p = Term::ProgressBar->new(NAME2, 10); },
 126                                                             'Count 1-10 ( 1)'),
 127                                                           'Count 1-10 ( 1)');
 128   ok (evcheck(sub { $p->update($_) for 1..3  },             'Count 1-10 ( 2)'),
 129                                                           'Count 1-10 ( 2)');
 130 };
 131 print $out;
 132
 133   $err =~ s!^.*\r!!gm;
 134   print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
 135     if $ENV{TEST_DEBUG};
 136   my @lines = split /\n/, $err;
 137
 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);
 141   print STDERR
 142     ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
 143     if $ENV{TEST_DEBUG};
 144   my $barexpect = $length * 0.3;
 145   my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
 146   ok $ok;
 147
 148 ($out, $err) = capture {
 149   ok (evcheck(sub { $p->message(MESSAGE1)    },             'Count 1-10 ( 5)'),
 150                                                           'Count 1-10 ( 5)');
 151   ok (evcheck(sub { $p->update($_) for 6..10 },             'Count 1-10 ( 6)'),
 152                                                           'Count 1-10 ( 6)');
 153 };
 154 print $out;
 155   $err =~ s!^.*\r!!gm;
 156   print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
 157     if $ENV{TEST_DEBUG};
 158
 159   @lines = split /\n/, $err;
 160
 161   like $lines[-1], qr/^@{[NAME2()]}: \s*\d+% \#*$/,            'Count 1-10 ( 8)';
 162   like $lines[-1], qr/^@{[NAME2()]}: \s*100%/,                 'Count 1-10 ( 9)';
 163 }
 164
 165 # -------------------------------------