Update Term::UI to 0.18

[p5sagit/p5-mst-13.2.git] / lib / Term / Cap.t

diff --git a/lib/Term/Cap.t b/lib/Term/Cap.t
index bceba75..08f042e 100644 (file)
--- a/lib/Term/Cap.t
+++ b/lib/Term/Cap.t
@@ -1,10 +1,14 @@
 #!./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 {
@@ -12,7 +16,20 @@ 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' );
 
@@ -30,8 +47,6 @@ if (open(TCOUT, ">tcout")) {
 # 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: {
@@ -42,7 +57,7 @@ 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}' );
 }
@@ -83,11 +98,16 @@ local $SIG{__WARN__} = sub {
 # 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 = '';
@@ -95,27 +115,29 @@ eval { $t = Term::Cap->Tgetent($vals) };
 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' );
 
-# if there's no valid termcap file found, it should croak 
-# (an empty string in $ENV{TERMPATH} and $ENV{TERM} counts as 'not found')
-$vals->{TERM} = '';
-$ENV{TERMPATH} = '';
-$ENV{TERMCAP} = '|:';
-eval { $t = Term::Cap->Tgetent($vals) };
-like( $@, qr/failed termcap lookup/, 'Tgetent() should die with bad termcap' );
+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", 8 ) unless $writable;
+       skip( "Can't write 'tcout' file for tests", 9 ) unless $writable;
+
+       # it won't find the termtype in this fake file, so it should croak
+       $vals->{TERM} = 'quux';
+       $ENV{TERMPATH} = 'tcout';
+       eval { $t = Term::Cap->Tgetent($vals) };
+       like( $@, qr/failed termcap/, 'Tgetent() should die with bad termcap' );
 
        # it shouldn't try to read one file more than 32(!) times
        # see __END__ for a really awful termcap example
-
        $ENV{TERMPATH} = join(' ', ('tcout') x 33);
        $vals->{TERM} = 'bar';
        eval { $t = Term::Cap->Tgetent($vals) };
@@ -136,6 +158,17 @@ SKIP: {
        is( $t->{_bc}, "\b", 'should set _bc field correctly' );
 }
 
+# Windows hack
+{
+   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' );
@@ -143,11 +176,16 @@ is( $out->read(), 'a1', 'Tgoto() should print to filehandle if passed' );
 
 $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;