#!./perl
my $file;
+
BEGIN {
- $file = $0;
- chdir 't' if -d 't';
- @INC = '../lib';
+ $file = $0;
+ chdir 't' if -d 't';
+
+ if ( $ENV{PERL_CORE} ) {
+ @INC = '../lib';
+ }
}
END {
1 while unlink('tcout');
}
-use Test::More tests => 43;
+use Test::More;
+
+# these names are hardcoded in Term::Cap
+my $files = join '',
+ grep { -f $_ }
+ ( $ENV{HOME} . '/.termcap', # we assume pretty UNIXy system anyway
+ '/etc/termcap',
+ '/usr/share/misc/termcap' );
+unless( $files || $^O eq 'VMS' ) {
+ plan skip_all => 'no termcap available to test';
+}
+else {
+ plan tests => 45;
+}
use_ok( 'Term::Cap' );
# termcap_path -- the names are hardcoded in Term::Cap
$ENV{TERMCAP} = '';
my $path = join '', Term::Cap::termcap_path();
-my $files = join '', grep { -f $_ } ( $ENV{HOME} . '/.termcap', '/etc/termcap',
- '/usr/share/misc/termcap' );
is( $path, $files, 'termcap_path() should find default files' );
SKIP: {
ok( grep($file, Term::Cap::termcap_path()),
'termcap_path() should find file from $ENV{TERMCAP}' );
- $ENV{TERMCAP} = (grep { $^O eq $_ } qw( os2 MSWin32 dos )) ? 'a:/' : '/';
+ $ENV{TERMCAP} = '/';
ok( grep($file, Term::Cap::termcap_path()),
'termcap_path() should find file from $ENV{TERMPATH}' );
}
# test the first few features by forcing Tgetent() to croak (line 156)
undef $ENV{TERM};
my $vals = {};
-eval { $t = Term::Cap->Tgetent($vals) };
+eval { local $^W = 1; $t = Term::Cap->Tgetent($vals) };
like( $@, qr/TERM not set/, 'Tgetent() should croaks without TERM' );
like( $warn, qr/OSPEED was not set/, 'Tgetent() should set default OSPEED' );
+
is( $vals->{PADDING}, 10000/9600, 'Default OSPEED implies default PADDING' );
+$warn = 'xxxx';
+eval { local $^W = 0; $t = Term::Cap->Tgetent($vals) };
+is($warn,'xxxx',"Tgetent() doesn't carp() without warnings on");
+
# check values for very slow speeds
$vals->{OSPEED} = 1;
$warn = '';
is( $warn, '', 'Tgetent() should not work if OSPEED is provided' );
is( $vals->{PADDING}, 200, 'Tgetent() should set slow PADDING when needed' );
-# now see if lines 177 or 180 will fail
-$ENV{TERM} = 'foo';
-$ENV{TERMPATH} = '!';
-$ENV{TERMCAP} = '';
-eval { $t = Term::Cap->Tgetent($vals) };
-isn't( $@, '', 'Tgetent() should catch bad termcap file' );
+
+SKIP: {
+ skip('Tgetent() bad termcap test, since using a fixed termcap',1)
+ if $^O eq 'VMS';
+ # now see if lines 177 or 180 will fail
+ $ENV{TERM} = 'foo';
+ $ENV{TERMPATH} = '!';
+ $ENV{TERMCAP} = '';
+ eval { $t = Term::Cap->Tgetent($vals) };
+ isn't( $@, '', 'Tgetent() should catch bad termcap file' );
+}
SKIP: {
skip( "Can't write 'tcout' file for tests", 9 ) unless $writable;
is( $t->{_bc}, "\b", 'should set _bc field correctly' );
}
+# Windows hack
+SKIP:
+{
+ skip("QNX's termcap database does not contain an entry for dumb terminals",
+ 1) if $^O eq 'nto';
+
+ local *^O;
+ local *ENV;
+ delete $ENV{TERM};
+ $^O = 'Win32';
+
+ my $foo = Term::Cap->Tgetent();
+ is($foo->{TERM} ,'dumb','Windows gets "dumb" by default');
+}
+
# Tgoto has comments on the expected formats
$t->{_test} = "a%d";
is( $t->Tgoto('test', '', 1, *OUT), 'a1', 'Tgoto() should handle %d code' );
$t->{_test} = "a%.";
like( $t->Tgoto('test', '', 1), qr/^a\x01/, 'Tgoto() should handle %.' );
-like( $t->Tgoto('test', '', 0), qr/\x61\x01\x08/,
- 'Tgoto() should handle %. and magic' );
+if (ord('A') == 193) { # EBCDIC platform
+ like( $t->Tgoto('test', '', 0), qr/\x81\x01\x16/,
+ 'Tgoto() should handle %. and magic' );
+ } else { # ASCII platform
+ like( $t->Tgoto('test', '', 0), qr/\x61\x01\x08/,
+ 'Tgoto() should handle %. and magic' );
+ }
$t->{_test} = 'a%+';
-like( $t->Tgoto('test', '', 1), qr/a\x01/, 'Tgoto() shoudl handle %+' );
+like( $t->Tgoto('test', '', 1), qr/a\x01/, 'Tgoto() should handle %+' );
$t->{_test} = 'a%+a';
is( $t->Tgoto('test', '', 1), 'ab', 'Tgoto() should handle %+char' );
$t->{_test} .= 'a' x 99;