1 # (X)Emacs mode: -*- cperl -*-
5 =head1 Unit Test Package for Term::ProgressBar v1.0 Compatibility
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.
12 # Utility -----------------------------
14 use Data::Dumper qw( );
15 use Test qw( ok plan );
17 # Test Setup --------------------------
25 # -------------------------------------
29 # Eval some code and return what was printed to stdout and stderr.
31 # Parameters: string of code to eval
33 # Returns: listref of [ stdout text, stderr text ]
36 die 'usage: grab_stderr(string to eval)' if @_ != 1;
38 use File::Temp qw(tempdir);
39 my $dir = tempdir( CLEANUP => 1 );
40 my $tmp_o = "$dir/out"; my $tmp_e = "$dir/err";
41 local (*OLDOUT, *OLDERR);
43 # Try to get a message to the outside world if we die
44 local $SIG{__DIE__} = sub { print $_[0]; die $_[0] };
46 open(OLDOUT, ">&STDOUT") or die "can't dup stdout: $!";
47 open(OLDERR, ">&STDERR") or die "can't dup stderr: $!";
48 open(STDOUT, ">$tmp_o") or die "can't open stdout to $tmp_o: $!";
49 open(STDERR, ">$tmp_e") or die "can't open stderr to $tmp_e: $!";
51 # Doubtful whether most of these messages will ever be seen!
52 close(STDOUT) or die "cannot close stdout opened to $tmp_o: $!";
53 close(STDERR) or die "cannot close stderr opened to $tmp_e: $!";
54 open(STDOUT, ">&OLDOUT") or die "can't dup stdout back again: $!";
55 open(STDERR, ">&OLDERR") or die "can't dup stderr back again: $!";
60 open (TMP_O, $tmp_o) or die "cannot open $tmp_o: $!";
61 open (TMP_E, $tmp_e) or die "cannot open $tmp_e: $!";
62 my $o = <TMP_O>; my $e = <TMP_E>;
63 close TMP_O or die "cannot close filehandle opened to $tmp_o: $!";
64 close TMP_E or die "cannot close filehandle opened to $tmp_e: $!";
65 unlink $tmp_o or die "cannot unlink $tmp_o: $!";
66 unlink $tmp_e or die "cannot unlink $tmp_e: $!";
71 # Change 1..1 below to 1..last_test_to_print .
72 # (It may become useful if the test is moved to ./t subdirectory.)
74 use Term::ProgressBar;
75 use POSIX qw<floor ceil>;
77 =head2 Test 1: compilation
79 This test confirms that the test script and the modules it calls compiled
84 ok 1, 1, 'compilation';
86 # -------------------------------------
92 # Test 2: create a bar
93 my $test_str = 'test';
96 my $o = grab_output("\$b = new Term::ProgressBar '$test_str', $count");
97 if (not $b or $o->[0] ne '' or $o->[1] ne "$test_str: ") {
98 print Data::Dumper->Dump([$b, $o], [qw( b o )])
104 # Test 3: do half the stuff and check half the bar has printed
105 my $halfway = floor($count / 2);
106 $o = grab_output("update \$b foreach (0 .. $halfway - 1)");
108 or $o->[1] ne ('#' x floor(50 / 2)) )
110 print Data::Dumper->Dump([$o], [qw( o )])
116 # Test 4: do the rest of the stuff and check the whole bar has printed
117 $o = grab_output("update \$b foreach ($halfway .. $count - 1)");
119 or $o->[1] ne ('#' x ceil(50 / 2)) . "\n" )
121 print Data::Dumper->Dump([$o], [qw( o )])
127 # Test 5: try to do another item and check there is an error
131 (substr($@, 0, length(Term::ProgressBar::ALREADY_FINISHED))
132 eq Term::ProgressBar::ALREADY_FINISHED) ) {
133 print Data::Dumper->Dump([$@], [qw( @ )])