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