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          qw( ok plan );
  14
  15 use lib $Bin;
  16 use test qw(
  17              evcheck restore_output save_output );
  18
  19 use constant MESSAGE1 => 'The Gospel of St. Jude';
  20 use constant NAME1    => 'Algenon';
  21 use constant NAME2    => 'Smegma';
  22
  23 BEGIN {
  24   # 1 for compilation test,
  25   plan tests  => 18,
  26        todo   => [],
  27 }
  28
  29 =head2 Test 1: compilation
  30
  31 This test confirms that the test script and the modules it calls compiled
  32 successfully.
  33
  34 =cut
  35
  36 use Term::ProgressBar;
  37
  38 ok 1, 1, 'compilation';
  39
  40 Term::ProgressBar->__force_term (50);
  41
  42 # -------------------------------------
  43
  44 =head2 Tests 2--10: Count 1-10
  45
  46 Create a progress bar with 10 things, and a name 'Algenon'.
  47 Update it it from 1 to 10.
  48
  49 (1) Check no exception thrown on creation
  50 (2) Check no exception thrown on update (1..3)
  51 (3) Check bar number is 30%
  52 (4) Check bar is 30% along
  53 (5) Check no exception thrown on message send
  54 (6) Check no exception thrown on update (6..10)
  55 (7) Check message seen
  56 (8) Check bar is complete
  57 (9) Check bar number is 100%
  58
  59 =cut
  60
  61 {
  62   my $p;
  63   save_output('stderr', *STDERR{IO});
  64   ok (evcheck(sub {
  65                 $p = Term::ProgressBar->new({count => 10, name => NAME1});
  66               },                                            'Count 1-10 ( 1)'),
  67       1,                                                    'Count 1-10 ( 1)');
  68   ok (evcheck(sub { $p->update($_) for 1..3  },             'Count 1-10 ( 2)'),
  69       1,                                                    'Count 1-10 ( 2)');
  70
  71   my $err = restore_output('stderr');
  72
  73   $err =~ s!^.*\r!!gm;
  74   print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
  75     if $ENV{TEST_DEBUG};
  76   my @lines = split /\n/, $err;
  77   ok $lines[-1], qr/^@{[NAME1()]}: \s*\b30%/,                'Count 1-10 ( 3)';
  78   my ($bar, $space) = $lines[-1] =~ /\[(=*)(\s*)\]/;
  79   my $length = length($bar) + length($space);
  80   print STDERR
  81     ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
  82     if $ENV{TEST_DEBUG};
  83   my $barexpect = $length * 0.3;
  84   my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
  85   ok $ok;
  86
  87   save_output('stderr', *STDERR{IO});
  88
  89   ok (evcheck(sub { $p->message(MESSAGE1)    },             'Count 1-10 ( 5)'),
  90       1,                                                    'Count 1-10 ( 5)');
  91   ok (evcheck(sub { $p->update($_) for 6..10 },             'Count 1-10 ( 6)'),
  92       1,                                                    'Count 1-10 ( 6)');
  93   $err = restore_output('stderr');
  94
  95   $err =~ s!^.*\r!!gm;
  96   print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
  97     if $ENV{TEST_DEBUG};
  98
  99   @lines = split /\n/, $err;
 100
 101   ok $lines[0], MESSAGE1,                                    'Count 1-10 ( 7)';
 102   ok $lines[-1], qr/\[=+\]/,                                 'Count 1-10 ( 8)';
 103   ok $lines[-1], qr/^@{[NAME1()]}: \s*100%/,                 'Count 1-10 ( 9)';
 104 }
 105
 106 # -------------------------------------
 107
 108 =head2 Tests 11--20: Count 1-20
 109
 110 Create a progress bar with 20 things, and a name 'Smegma'.
 111 Update it it from 1 to 20.
 112 Use v1 mode
 113
 114 (1) Check no exception thrown on creation
 115 (2) Check no exception thrown on update (1..12)
 116 (3) Check bar number is 60%
 117 (4) Check bar is 60% along
 118 (5) Check no exception thrown on message send
 119 (6) Check no exception thrown on update (13..20)
 120 (7) Check message seen
 121 (8) Check bar is complete
 122 (9) Check bar number is 100%
 123
 124 =cut
 125
 126 {
 127   my $p;
 128   save_output('stderr', *STDERR{IO});
 129   ok (evcheck(sub { $p = Term::ProgressBar->new(NAME2, 10); },
 130                                                             'Count 1-10 ( 1)'),
 131       1,                                                    'Count 1-10 ( 1)');
 132   ok (evcheck(sub { $p->update($_) for 1..3  },             'Count 1-10 ( 2)'),
 133       1,                                                    'Count 1-10 ( 2)');
 134
 135   my $err = restore_output('stderr');
 136
 137   $err =~ s!^.*\r!!gm;
 138   print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
 139     if $ENV{TEST_DEBUG};
 140   my @lines = split /\n/, $err;
 141   ok $lines[-1], qr/^@{[NAME2()]}: \s*\b30%/,                'Count 1-10 ( 3)';
 142   my ($bar, $space) = $lines[-1] =~ /(\#*)(\s*)/;
 143   my $length = length($bar) + length($space);
 144   print STDERR
 145     ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
 146     if $ENV{TEST_DEBUG};
 147   my $barexpect = $length * 0.3;
 148   my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
 149   ok $ok;
 150
 151   save_output('stderr', *STDERR{IO});
 152
 153   ok (evcheck(sub { $p->message(MESSAGE1)    },             'Count 1-10 ( 5)'),
 154       1,                                                    'Count 1-10 ( 5)');
 155   ok (evcheck(sub { $p->update($_) for 6..10 },             'Count 1-10 ( 6)'),
 156       1,                                                    'Count 1-10 ( 6)');
 157   $err = restore_output('stderr');
 158
 159   $err =~ s!^.*\r!!gm;
 160   print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
 161     if $ENV{TEST_DEBUG};
 162
 163   @lines = split /\n/, $err;
 164
 165   ok $lines[-1], qr/^@{[NAME2()]}: \s*\d+% \#*$/,            'Count 1-10 ( 8)';
 166   ok $lines[-1], qr/^@{[NAME2()]}: \s*100%/,                 'Count 1-10 ( 9)';
 167 }
 168
 169 # -------------------------------------