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);
  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 ($out, $err) = capture {
  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   print $out;
  53
  54   $err =~ s!^.*\r!!gm;
  55   diag "ERR (1) :\n$err\nlength: " . length($err)
  56     if $ENV{TEST_DEBUG};
  57   my @lines = split /\n/, $err;
  58
  59   like $lines[-1], qr/^@{[$NAME1]}: \s*\b30%/,                'Count 1-10 ( 3)';
  60   my ($bar, $space) = $lines[-1] =~ /\[(=*)(\s*)\]/;
  61   my $length = length($bar) + length($space);
  62   print STDERR
  63     ("LENGTHS (1) :BAR:", length($bar), ":SPACE:", length($space), "\n")
  64     if $ENV{TEST_DEBUG};
  65   my $barexpect = $length * 0.3;
  66   cmp_ok length($bar), '>', $barexpect -1;
  67   cmp_ok length($bar), '<', $barexpect+1;
  68
  69
  70   ($out, $err) = capture {
  71     lives_ok { $p->message($MESSAGE1)    } 'Count 1-10 ( 5)';
  72     lives_ok { $p->update($_) for 6..10 } 'Count 1-10 ( 6)';
  73   };
  74   print $out;
  75
  76   $err =~ s!^.*\r!!gm;
  77   diag "ERR (2) :\n$err\nlength: " . length($err)
  78     if $ENV{TEST_DEBUG};
  79
  80   @lines = split /\n/, $err;
  81
  82   is $lines[0], $MESSAGE1,                                    'Count 1-10 ( 7)';
  83   like $lines[-1], qr/\[=+\]/,                                 'Count 1-10 ( 8)';
  84   like $lines[-1], qr/^@{[$NAME1]}: \s*100%/,                 'Count 1-10 ( 9)';
  85 }
  86
  87 # -------------------------------------
  88
  89 =head2 Tests 11--20: Count 1-20
  90
  91 Create a progress bar with 20 things, and a name 'Smegma'.
  92 Update it it from 1 to 20.
  93 Use v1 mode
  94
  95 (1) Check no exception thrown on creation
  96 (2) Check no exception thrown on update (1..12)
  97 (3) Check bar number is 60%
  98 (4) Check bar is 60% along
  99 (5) Check no exception thrown on message send
 100 (6) Check no exception thrown on update (13..20)
 101 (7) Check message seen
 102 (8) Check bar is complete
 103 (9) Check bar number is 100%
 104
 105 =cut
 106
 107 {
 108   my $p;
 109   my ($out, $err) = capture {
 110     lives_ok { $p = Term::ProgressBar->new($NAME2, 10); } 'Count 1-10 ( 1)';
 111     lives_ok { $p->update($_) for 1..3  }                'Count 1-10 ( 2)';
 112   };
 113   print $out;
 114
 115   $err =~ s!^.*\r!!gm;
 116   diag "ERR (1) :\n$err\nlength: " . length($err)
 117     if $ENV{TEST_DEBUG};
 118   my @lines = split /\n/, $err;
 119
 120   like $lines[-1], qr/^@{[$NAME2]}: \s*\b30%/,                'Count 1-10 ( 3)';
 121   my ($bar, $space) = $lines[-1] =~ /(\#*)(\s*)/;
 122   my $length = length($bar) + length($space);
 123   diag
 124     ("LENGTHS (1) :BAR:" . length($bar) . ":SPACE:" . length($space))
 125       if $ENV{TEST_DEBUG};
 126   my $barexpect = $length * 0.3;
 127   cmp_ok length($bar), '>', $barexpect -1;
 128   cmp_ok length($bar), '<', $barexpect+1;
 129
 130   ($out, $err) = capture {
 131     lives_ok { $p->message($MESSAGE1)    }  'Count 1-10 ( 5)';
 132     lives_ok { $p->update($_) for 6..10 }  'Count 1-10 ( 6)';
 133   };
 134   print $out;
 135
 136   $err =~ s!^.*\r!!gm;
 137   diag "ERR (2) :\n$err\nlength: " . length($err)
 138     if $ENV{TEST_DEBUG};
 139
 140   @lines = split /\n/, $err;
 141
 142   like $lines[-1], qr/^@{[$NAME2]}: \s*\d+% \#*$/,            'Count 1-10 ( 8)';
 143   like $lines[-1], qr/^@{[$NAME2]}: \s*100%/,                 'Count 1-10 ( 9)';
 144 }
 145
 146 # -------------------------------------