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( evcheck );
  17
  18 use constant MESSAGE1 => 'The Gospel of St. Jude';
  19 use constant NAME1    => 'Algenon';
  20 use constant NAME2    => 'Smegma';
  21
  22 BEGIN {
  23   # 1 for compilation test,
  24   plan tests  => 18,
  25        todo   => [],
  26 }
  27
  28 =head2 Test 1: compilation
  29
  30 This test confirms that the test script and the modules it calls compiled
  31 successfully.
  32
  33 =cut
  34
  35 use Term::ProgressBar;
  36
  37 ok 1, 1, 'compilation';
  38
  39 Term::ProgressBar->__force_term (50);
  40
  41 # -------------------------------------
  42
  43 =head2 Tests 2--10: Count 1-10
  44
  45 Create a progress bar with 10 things, and a name 'Algenon'.
  46 Update it it from 1 to 10.
  47
  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%
  57
  58 =cut
  59
  60 use Capture::Tiny qw(capture);
  61
  62 {
  63   my $p;
  64 my ($out, $err) = capture {
  65   ok (evcheck(sub {
  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)');
  71 };
  72 print $out;
  73
  74   $err =~ s!^.*\r!!gm;
  75   print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
  76     if $ENV{TEST_DEBUG};
  77   my @lines = split /\n/, $err;
  78
  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);
  82   print STDERR
  83     ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
  84     if $ENV{TEST_DEBUG};
  85   my $barexpect = $length * 0.3;
  86   my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
  87   ok $ok;
  88
  89 ($out, $err) = capture {
  90
  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)');
  95 };
  96 print $out;
  97
  98   $err =~ s!^.*\r!!gm;
  99   print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
 100     if $ENV{TEST_DEBUG};
 101
 102   @lines = split /\n/, $err;
 103
 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)';
 107 }
 108
 109 # -------------------------------------
 110
 111 =head2 Tests 11--20: Count 1-20
 112
 113 Create a progress bar with 20 things, and a name 'Smegma'.
 114 Update it it from 1 to 20.
 115 Use v1 mode
 116
 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%
 126
 127 =cut
 128
 129 {
 130   my $p;
 131 my ($out, $err) = capture {
 132   ok (evcheck(sub { $p = Term::ProgressBar->new(NAME2, 10); },
 133                                                             'Count 1-10 ( 1)'),
 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)');
 137 };
 138 print $out;
 139
 140   $err =~ s!^.*\r!!gm;
 141   print STDERR "ERR (1) :\n$err\nlength: ", length($err), "\n"
 142     if $ENV{TEST_DEBUG};
 143   my @lines = split /\n/, $err;
 144
 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);
 148   print STDERR
 149     ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
 150     if $ENV{TEST_DEBUG};
 151   my $barexpect = $length * 0.3;
 152   my $ok = length($bar) > $barexpect -1 && length($bar) < $barexpect+1;
 153   ok $ok;
 154
 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)');
 160 };
 161 print $out;
 162   $err =~ s!^.*\r!!gm;
 163   print STDERR "ERR (2) :\n$err\nlength: ", length($err), "\n"
 164     if $ENV{TEST_DEBUG};
 165
 166   @lines = split /\n/, $err;
 167
 168   ok $lines[-1], qr/^@{[NAME2()]}: \s*\d+% \#*$/,            'Count 1-10 ( 8)';
 169   ok $lines[-1], qr/^@{[NAME2()]}: \s*100%/,                 'Count 1-10 ( 9)';
 170 }
 171
 172 # -------------------------------------