t/compat.t

   1 # (X)Emacs mode: -*- cperl -*-
   2
   3 use strict;
   4
   5 =head1 Unit Test Package for Term::ProgressBar v1.0 Compatibility
   6
   7 This script is based on the test script for Term::ProgressBar version 1.0,
   8 and is intended to test compatibility with that version.
   9
  10 =cut
  11
  12 # Utility -----------------------------
  13
  14 use Data::Dumper qw( );
  15 use Test::More tests => 4;
  16
  17 # -------------------------------------
  18
  19 # grab_output()
  20 #
  21 # Eval some code and return what was printed to stdout and stderr.
  22 #
  23 # Parameters: string of code to eval
  24 #
  25 # Returns: listref of [ stdout text, stderr text ]
  26 #
  27 sub grab_output($) {
  28     die 'usage: grab_stderr(string to eval)' if @_ != 1;
  29     my $code = shift;
  30         use File::Temp qw(tempdir);
  31         my $dir = tempdir( CLEANUP => 1 );
  32     my $tmp_o = "$dir/out"; my $tmp_e = "$dir/err";
  33     local (*OLDOUT, *OLDERR);
  34
  35     # Try to get a message to the outside world if we die
  36     local $SIG{__DIE__} = sub { print $_[0]; die $_[0] };
  37
  38     open(OLDOUT, ">&STDOUT") or die "can't dup stdout: $!";
  39     open(OLDERR, ">&STDERR") or die "can't dup stderr: $!";
  40     open(STDOUT, ">$tmp_o")  or die "can't open stdout to $tmp_o: $!";
  41     open(STDERR, ">$tmp_e")  or die "can't open stderr to $tmp_e: $!";
  42     eval $code;
  43     # Doubtful whether most of these messages will ever be seen!
  44     close(STDOUT)            or die "cannot close stdout opened to $tmp_o: $!";
  45     close(STDERR)            or die "cannot close stderr opened to $tmp_e: $!";
  46     open(STDOUT, ">&OLDOUT") or die "can't dup stdout back again: $!";
  47     open(STDERR, ">&OLDERR") or die "can't dup stderr back again: $!";
  48
  49     die $@ if $@;
  50
  51     local $/ = undef;
  52     open (TMP_O, $tmp_o) or die "cannot open $tmp_o: $!";
  53     open (TMP_E, $tmp_e) or die "cannot open $tmp_e: $!";
  54     my $o = <TMP_O>; my $e = <TMP_E>;
  55     close TMP_O   or die "cannot close filehandle opened to $tmp_o: $!";
  56     close TMP_E   or die "cannot close filehandle opened to $tmp_e: $!";
  57     unlink $tmp_o or die "cannot unlink $tmp_o: $!";
  58     unlink $tmp_e or die "cannot unlink $tmp_e: $!";
  59
  60     return [ $o, $e ];
  61 }
  62
  63 use Term::ProgressBar;
  64 use POSIX qw<floor ceil>;
  65
  66 $| = 1;
  67
  68 my $count = 100;
  69
  70 # Test 2: create a bar
  71 my $test_str = 'test';
  72
  73 use vars '$b';
  74 my $o = grab_output("\$b = new Term::ProgressBar '$test_str', $count");
  75 if (not $b or $o->[0] ne '' or $o->[1] ne "$test_str: ") {
  76     print Data::Dumper->Dump([$b, $o], [qw( b o )])
  77       if $ENV{TEST_DEBUG};
  78     print 'not ';
  79 }
  80 ok 1;
  81
  82 # Test 3: do half the stuff and check half the bar has printed
  83 my $halfway = floor($count / 2);
  84 $o = grab_output("update \$b foreach (0 .. $halfway - 1)");
  85 if ($o->[0] ne ''
  86     or $o->[1] ne ('#' x floor(50 / 2)) )
  87 {
  88     print Data::Dumper->Dump([$o], [qw( o )])
  89       if $ENV{TEST_DEBUG};
  90     print 'not ';
  91 }
  92 ok 1;
  93
  94 # Test 4: do the rest of the stuff and check the whole bar has printed
  95 $o = grab_output("update \$b foreach ($halfway .. $count - 1)");
  96 if ($o->[0] ne ''
  97     or $o->[1] ne ('#' x ceil(50 / 2)) . "\n" )
  98 {
  99     print Data::Dumper->Dump([$o], [qw( o )])
 100       if $ENV{TEST_DEBUG};
 101     print 'not ';
 102 }
 103 ok 1;
 104
 105 # Test 5: try to do another item and check there is an error
 106 eval { update $b };
 107 unless ( defined($@)
 108          and
 109          (substr($@, 0, length(Term::ProgressBar::ALREADY_FINISHED))
 110           eq Term::ProgressBar::ALREADY_FINISHED) ) {
 111   print Data::Dumper->Dump([$@], [qw( @ )])
 112     if $ENV{TEST_DEBUG};
 113   print 'not ';
 114 }
 115 ok 1;