1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate} 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gateuse warnings; 9*0Sstevel@tonic-gateuse Test::More tests => 8; 10*0Sstevel@tonic-gateuse vars qw( $Term::Complete::complete $complete $Term::Complete::stty ); 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gateSKIP: { 13*0Sstevel@tonic-gate skip('PERL_SKIP_TTY_TEST', 8) if $ENV{PERL_SKIP_TTY_TEST}; 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gate use_ok( 'Term::Complete' ); 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gate # this skips tests AND prevents the "used only once" warning 18*0Sstevel@tonic-gate skip('No stty, Term::Complete will not run here', 7) 19*0Sstevel@tonic-gate unless defined $Term::Complete::tty_raw_noecho && 20*0Sstevel@tonic-gate defined $Term::Complete::tty_restore; 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gate # also prevent Term::Complete from running stty and messing up the terminal 23*0Sstevel@tonic-gate undef $Term::Complete::tty_restore; 24*0Sstevel@tonic-gate undef $Term::Complete::tty_raw_noecho; 25*0Sstevel@tonic-gate undef $Term::Complete::stty; 26*0Sstevel@tonic-gate 27*0Sstevel@tonic-gate *complete = \$Term::Complete::complete; 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gate my $in = tie *STDIN, 'FakeIn', "fro\t"; 30*0Sstevel@tonic-gate my $out = tie *STDOUT, 'FakeOut'; 31*0Sstevel@tonic-gate my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' ); 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gate Complete('', \@words); 34*0Sstevel@tonic-gate my $data = get_expected('fro', @words); 35*0Sstevel@tonic-gate 36*0Sstevel@tonic-gate # there should be an \a after our word 37*0Sstevel@tonic-gate like( $$out, qr/fro\a/, 'found bell character' ); 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gate # now remove the \a -- there should be only one 40*0Sstevel@tonic-gate is( $out->scrub(), 1, '(single) bell removed'); 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gate # 'fro' should match all three words 43*0Sstevel@tonic-gate like( $$out, qr/$data/, 'all three words possible' ); 44*0Sstevel@tonic-gate $out->clear(); 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gate # should only find 'frobnitz' and 'frobozz' 47*0Sstevel@tonic-gate $in->add('frob'); 48*0Sstevel@tonic-gate Complete('', @words); 49*0Sstevel@tonic-gate $out->scrub(); 50*0Sstevel@tonic-gate is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' ); 51*0Sstevel@tonic-gate $out->clear(); 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gate # should only do 'frobozz' 54*0Sstevel@tonic-gate $in->add('frobo'); 55*0Sstevel@tonic-gate Complete('', @words); 56*0Sstevel@tonic-gate $out->scrub(); 57*0Sstevel@tonic-gate is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' ); 58*0Sstevel@tonic-gate $out->clear(); 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gate # change the completion character 61*0Sstevel@tonic-gate $complete = "!"; 62*0Sstevel@tonic-gate $in->add('frobn'); 63*0Sstevel@tonic-gate Complete('prompt:', @words); 64*0Sstevel@tonic-gate $out->scrub(); 65*0Sstevel@tonic-gate like( $$out, qr/prompt:frobn/, 'prompt is okay' ); 66*0Sstevel@tonic-gate 67*0Sstevel@tonic-gate # now remove the prompt and we should be okay 68*0Sstevel@tonic-gate $$out =~ s/prompt://g; 69*0Sstevel@tonic-gate is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' ); 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gate} # end of SKIP, end of tests 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate# easier than matching space characters 74*0Sstevel@tonic-gatesub get_expected { 75*0Sstevel@tonic-gate my $word = shift; 76*0Sstevel@tonic-gate return join('.', $word, @_, $word, '.'); 77*0Sstevel@tonic-gate} 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gatepackage FakeIn; 80*0Sstevel@tonic-gate 81*0Sstevel@tonic-gatesub TIEHANDLE { 82*0Sstevel@tonic-gate my ($class, $text) = @_; 83*0Sstevel@tonic-gate $text .= "$main::complete\025"; 84*0Sstevel@tonic-gate bless(\$text, $class); 85*0Sstevel@tonic-gate} 86*0Sstevel@tonic-gate 87*0Sstevel@tonic-gatesub add { 88*0Sstevel@tonic-gate my ($self, $text) = @_; 89*0Sstevel@tonic-gate $$self = $text . "$main::complete\025"; 90*0Sstevel@tonic-gate} 91*0Sstevel@tonic-gate 92*0Sstevel@tonic-gatesub GETC { 93*0Sstevel@tonic-gate my $self = shift; 94*0Sstevel@tonic-gate return length $$self ? substr($$self, 0, 1, '') : "\r"; 95*0Sstevel@tonic-gate} 96*0Sstevel@tonic-gate 97*0Sstevel@tonic-gatepackage FakeOut; 98*0Sstevel@tonic-gate 99*0Sstevel@tonic-gatesub TIEHANDLE { 100*0Sstevel@tonic-gate bless(\(my $text), $_[0]); 101*0Sstevel@tonic-gate} 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gatesub clear { 104*0Sstevel@tonic-gate ${ $_[0] } = ''; 105*0Sstevel@tonic-gate} 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gate# remove the bell character 108*0Sstevel@tonic-gatesub scrub { 109*0Sstevel@tonic-gate ${ $_[0] } =~ tr/\a//d; 110*0Sstevel@tonic-gate} 111*0Sstevel@tonic-gate 112*0Sstevel@tonic-gate# must shift off self 113*0Sstevel@tonic-gatesub PRINT { 114*0Sstevel@tonic-gate my $self = shift; 115*0Sstevel@tonic-gate ($$self .= join('', @_)) =~ s/\s+/./gm; 116*0Sstevel@tonic-gate} 117