t/name.t

   1 # (X)Emacs mode: -*- cperl -*-
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 Unit Test Package for Term::ProgressBar
   7
   8 This package tests the name functionality of Term::ProgressBar.
   9
  10 =cut
  11
  12 use Test::More tests => 20;
  13 use Test::Exception;
  14
  15 use Capture::Tiny qw(capture_stderr);
  16
  17 my $MESSAGE1 = 'The Gospel of St. Jude';
  18 my $NAME1    = 'Algenon';
  19 my $NAME2    = 'Smegma';
  20
  21 use_ok 'Term::ProgressBar';
  22
  23 Term::ProgressBar->__force_term (50);
  24
  25 # -------------------------------------
  26
  27 =head2 Tests 2--10: Count 1-10
  28
  29 Create a progress bar with 10 things, and a name 'Algenon'.
  30 Update it it from 1 to 10.
  31
  32 (1) Check no exception thrown on creation
  33 (2) Check no exception thrown on update (1..3)
  34 (3) Check bar number is 30%
  35 (4) Check bar is 30% along
  36 (5) Check no exception thrown on message send
  37 (6) Check no exception thrown on update (6..10)
  38 (7) Check message seen
  39 (8) Check bar is complete
  40 (9) Check bar number is 100%
  41
  42 =cut
  43
  44 {
  45   my $p;
  46   my $err = capture_stderr {
  47     lives_ok {
  48                 $p = Term::ProgressBar->new({count => 10, name => $NAME1});
  49               } 'Count 1-10 ( 1)';
  50     lives_ok { $p->update($_) for 1..3  } 'Count 1-10 ( 2)';
  51   };
  52
  53   $err =~ s!^.*\r!!gm;
  54   diag "ERR (1) :\n$err\nlength: " . length($err)
  55     if $ENV{TEST_DEBUG};
  56   my @lines = split /\n/, $err;
  57
  58   like $lines[-1], qr/^@{[$NAME1]}: \s*\b30%/,                'Count 1-10 ( 3)';
  59   my ($bar, $space) = $lines[-1] =~ /\[(=*)(\s*)\]/;
  60   my $length = length($bar) + length($space);
  61   print STDERR
  62     ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
  63     if $ENV{TEST_DEBUG};
  64   my $barexpect = $length * 0.3;
  65   cmp_ok length($bar), '>', $barexpect -1;
  66   cmp_ok length($bar), '<', $barexpect+1;
  67
  68
  69   $err = capture_stderr {
  70     lives_ok { $p->message($MESSAGE1)    } 'Count 1-10 ( 5)';
  71     lives_ok { $p->update($_) for 6..10 } 'Count 1-10 ( 6)';
  72   };
  73
  74   $err =~ s!^.*\r!!gm;
  75   diag "ERR (2) :\n$err\nlength: " . length($err)
  76     if $ENV{TEST_DEBUG};
  77
  78   @lines = split /\n/, $err;
  79
  80   is $lines[0], $MESSAGE1,                                    'Count 1-10 ( 7)';
  81   like $lines[-1], qr/\[=+\]/,                                 'Count 1-10 ( 8)';
  82   like $lines[-1], qr/^@{[$NAME1]}: \s*100%/,                 'Count 1-10 ( 9)';
  83 }
  84
  85 # -------------------------------------
  86
  87 =head2 Tests 11--20: Count 1-20
  88
  89 Create a progress bar with 20 things, and a name 'Smegma'.
  90 Update it it from 1 to 20.
  91 Use v1 mode
  92
  93 (1) Check no exception thrown on creation
  94 (2) Check no exception thrown on update (1..12)
  95 (3) Check bar number is 60%
  96 (4) Check bar is 60% along
  97 (5) Check no exception thrown on message send
  98 (6) Check no exception thrown on update (13..20)
  99 (7) Check message seen
 100 (8) Check bar is complete
 101 (9) Check bar number is 100%
 102
 103 =cut
 104
 105 {
 106   my $p;
 107   my $err = capture_stderr {
 108     lives_ok { $p = Term::ProgressBar->new($NAME2, 10); } 'Count 1-10 ( 1)';
 109     lives_ok { $p->update($_) for 1..3  }                'Count 1-10 ( 2)';
 110   };
 111
 112   $err =~ s!^.*\r!!gm;
 113   diag "ERR (1) :\n$err\nlength: " . length($err)
 114     if $ENV{TEST_DEBUG};
 115   my @lines = split /\n/, $err;
 116
 117   like $lines[-1], qr/^@{[$NAME2]}: \s*\b30%/,                'Count 1-10 ( 3)';
 118   my ($bar, $space) = $lines[-1] =~ /(\#*)(\s*)/;
 119   my $length = length($bar) + length($space);
 120   diag
 121     ("LENGTHS (1) :BAR:" . length($bar) . ":SPACE:" . length($space))
 122       if $ENV{TEST_DEBUG};
 123   my $barexpect = $length * 0.3;
 124   cmp_ok length($bar), '>', $barexpect -1;
 125   cmp_ok length($bar), '<', $barexpect+1;
 126
 127   $err = capture_stderr {
 128     lives_ok { $p->message($MESSAGE1)    }  'Count 1-10 ( 5)';
 129     lives_ok { $p->update($_) for 6..10 }  'Count 1-10 ( 6)';
 130   };
 131
 132   $err =~ s!^.*\r!!gm;
 133   diag "ERR (2) :\n$err\nlength: " . length($err)
 134     if $ENV{TEST_DEBUG};
 135
 136   @lines = split /\n/, $err;
 137
 138   like $lines[-1], qr/^@{[$NAME2]}: \s*\d+% \#*$/,            'Count 1-10 ( 8)';
 139   like $lines[-1], qr/^@{[$NAME2]}: \s*100%/,                 'Count 1-10 ( 9)';
 140 }
 141
 142 # -------------------------------------