From: Jarkko Hietaniemi Date: Fri, 12 Oct 2001 22:44:24 +0000 (+0000) Subject: [PATCH lib/Term/Complete.t] Rethinking the Test X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=25f74a49caf62321c758629ba724a4dcbeb9fc99;p=p5sagit%2Fp5-mst-13.2.git [PATCH lib/Term/Complete.t] Rethinking the Test From: "chromatic" Date: Thu, 11 Oct 2001 10:57:55 -0600 Message-ID: <20011011170354.74354.qmail@onion.perl.org> Subject: [PATCH Complete.pm] Re: [PATCH lib/Term/Complete.t] Rethinking the Test From: Rafael Garcia-Suarez Date: Thu, 11 Oct 2001 22:34:21 +0200 Message-ID: <20011011223421.A693@rafael> plus undef $Term::Complete::stty as suggested by Rafael. p4raw-id: //depot/perl@12418 --- diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm index 0e783de..308af04 100644 --- a/lib/Term/Complete.pm +++ b/lib/Term/Complete.pm @@ -5,7 +5,7 @@ require Exporter; use strict; our @ISA = qw(Exporter); our @EXPORT = qw(Complete); -our $VERSION = '1.3'; +our $VERSION = '1.4'; # @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91 @@ -24,8 +24,7 @@ This routine provides word completion on the list of words in the array (or array ref). The tty driver is put into raw mode and restored using an operating -system specific command, in UNIX-like environments C -and C. +system specific command, in UNIX-like environments C. The following command characters are defined: @@ -67,16 +66,18 @@ Wayne Thompson =cut -our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore); +our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty); +our($tty_saved_state) = ''; CONFIG: { $complete = "\004"; $kill = "\025"; $erase1 = "\177"; $erase2 = "\010"; - foreach my $stty (qw(/bin/stty /usr/bin/stty)) { - if (-x $stty) { - $tty_raw_noecho = "$stty raw -echo"; - $tty_restore = "$stty -raw echo"; + foreach my $s (qw(/bin/stty /usr/bin/stty)) { + if (-x $s) { + $tty_raw_noecho = "$s raw -echo"; + $tty_restore = "$s -raw echo"; + $stty = $s; last; } } @@ -97,6 +98,17 @@ sub Complete { @cmp_lst = sort(@_); } + # Attempt to save the current stty state, to be restored later + if (defined $stty && defined $tty_saved_state && $tty_saved_state eq '') { + $tty_saved_state = qx($stty -g 2>/dev/null); + if ($?) { + # stty -g not supported + $tty_saved_state = undef; + } + else { + $tty_restore = qq($stty "$tty_saved_state"); + } + } system $tty_raw_noecho if defined $tty_raw_noecho; LOOP: { print($prompt, $return); diff --git a/lib/Term/Complete.t b/lib/Term/Complete.t index bfff3fb..e49497e 100644 --- a/lib/Term/Complete.t +++ b/lib/Term/Complete.t @@ -7,69 +7,66 @@ BEGIN { use warnings; use Test::More tests => 8; -use vars qw( $Term::Complete::complete $complete ); -my $restore; +use vars qw( $Term::Complete::complete $complete $Term::Complete::stty ); SKIP: { - skip('PERL_SKIP_TTY_TEST', 8) if $ENV{PERL_SKIP_TTY_TEST} or !(-t STDIN); + skip('PERL_SKIP_TTY_TEST', 7) if $ENV{PERL_SKIP_TTY_TEST}; - my $TTY; - if ($^O eq 'rhapsody' && -c "/dev/ttyp0") { $TTY = "/dev/ttyp0" } - elsif (-c "/dev/tty") { $TTY = "/dev/tty" } - if (defined $TTY) { - open(TTY, $TTY) or die "open $TTY failed: $!"; - skip("$TTY not a tty", 8) if defined $TTY && ! -t TTY; - $restore = `stty -g`; - skip("Can't reliably restore $TTY", 8) if $?; - } - -use_ok( 'Term::Complete' ); - -*complete = \$Term::Complete::complete; - -my $in = tie *STDIN, 'FakeIn', "fro\t"; -my $out = tie *STDOUT, 'FakeOut'; -my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' ); - -Complete('', \@words); -my $data = get_expected('fro', @words); - -# there should be an \a after our word -like( $$out, qr/fro\a/, 'found bell character' ); - -# now remove the \a -- there should be only one -is( $out->scrub(), 1, '(single) bell removed'); - -# 'fro' should match all three words -like( $$out, qr/$data/, 'all three words possible' ); -$out->clear(); - -# should only find 'frobnitz' and 'frobozz' -$in->add('frob'); -Complete('', @words); -$out->scrub(); -is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' ); -$out->clear(); - -# should only do 'frobozz' -$in->add('frobo'); -Complete('', @words); -$out->scrub(); -is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' ); -$out->clear(); - -# change the completion character -$complete = "!"; -$in->add('frobn'); -Complete('prompt:', @words); -$out->scrub(); -like( $$out, qr/prompt:frobn/, 'prompt is okay' ); - -# now remove the prompt and we should be okay -$$out =~ s/prompt://g; -is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' ); - -`stty $restore` if defined $restore; + use_ok( 'Term::Complete' ); + + # this skips tests AND prevents the "used only once" warning + skip('No stty, Term::Complete will not run here', 7) + unless defined $Term::Complete::tty_raw_noecho && + defined $Term::Complete::tty_restore; + + # also prevent Term::Complete from running stty and messing up the terminal + undef $Term::Complete::tty_restore; + undef $Term::Complete::tty_raw_noecho; + undef $Term::Complete::stty; + + *complete = \$Term::Complete::complete; + + my $in = tie *STDIN, 'FakeIn', "fro\t"; + my $out = tie *STDOUT, 'FakeOut'; + my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' ); + + Complete('', \@words); + my $data = get_expected('fro', @words); + + # there should be an \a after our word + like( $$out, qr/fro\a/, 'found bell character' ); + + # now remove the \a -- there should be only one + is( $out->scrub(), 1, '(single) bell removed'); + + # 'fro' should match all three words + like( $$out, qr/$data/, 'all three words possible' ); + $out->clear(); + + # should only find 'frobnitz' and 'frobozz' + $in->add('frob'); + Complete('', @words); + $out->scrub(); + is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' ); + $out->clear(); + + # should only do 'frobozz' + $in->add('frobo'); + Complete('', @words); + $out->scrub(); + is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' ); + $out->clear(); + + # change the completion character + $complete = "!"; + $in->add('frobn'); + Complete('prompt:', @words); + $out->scrub(); + like( $$out, qr/prompt:frobn/, 'prompt is okay' ); + + # now remove the prompt and we should be okay + $$out =~ s/prompt://g; + is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' ); } # end of SKIP, end of tests