1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
#!/usr/bin/env perl
use strict;
use warnings;
BEGIN {
chdir 't' if -d 't';
use File::Spec;
}
use Test::More 'no_plan';
my $Class = 'Term::UI::History';
my $Func = 'history';
my $Verbose = 0; # print to STDOUT?
### test load & exports
{ use_ok( $Class );
for my $pkg ( $Class, __PACKAGE__ ) {
can_ok( $pkg, $Func );
}
}
### test string recording
{ history( $$, $Verbose );
my $str = $Class->history_as_string;
ok( $str, "Message recorded" );
is( $str, $$, " With appropriate content" );
$Class->flush;
ok( !$Class->history_as_string,
" Stack flushed" );
}
### test filehandle printing
SKIP: {
my $file = "$$.tmp";
{ open my $fh, ">$file" or skip "Could not open $file: $!", 6;
### declare twice for 'used only once' warning
local $Term::UI::History::HISTORY_FH = $fh;
local $Term::UI::History::HISTORY_FH = $fh;
history( $$ );
close $fh;
}
my $str = $Class->history_as_string;
ok( $str, "Message recorded" );
is( $str, $$, " With appropriate content" );
### check file contents
{ ok( -e $file, "File $file exists" );
ok( -s $file, " File has size" );
open my $fh, $file or skip "Could not open $file: $!", 2;
my $cont = do { local $/; <$fh> };
chomp $cont;
is( $cont, $str, " File has same content" );
}
$Class->flush;
### for VMS etc
1 while unlink $file;
ok( ! -e $file, " File $file removed" );
}
|
