1*0Sstevel@tonic-gate#!/usr/bin/perl -w 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate if( $ENV{PERL_CORE} ) { 5*0Sstevel@tonic-gate chdir 't' if -d 't'; 6*0Sstevel@tonic-gate @INC = ('../lib', 'lib'); 7*0Sstevel@tonic-gate } 8*0Sstevel@tonic-gate else { 9*0Sstevel@tonic-gate unshift @INC, 't/lib'; 10*0Sstevel@tonic-gate } 11*0Sstevel@tonic-gate} 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gateuse strict; 14*0Sstevel@tonic-gateuse Test::More tests => 11; 15*0Sstevel@tonic-gateuse ExtUtils::MakeMaker; 16*0Sstevel@tonic-gateuse TieOut; 17*0Sstevel@tonic-gateuse TieIn; 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gateeval q{ 20*0Sstevel@tonic-gate prompt(); 21*0Sstevel@tonic-gate}; 22*0Sstevel@tonic-gatelike( $@, qr/^Not enough arguments for ExtUtils::MakeMaker::prompt/, 23*0Sstevel@tonic-gate 'no args' ); 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gateeval { 26*0Sstevel@tonic-gate prompt(undef); 27*0Sstevel@tonic-gate}; 28*0Sstevel@tonic-gatelike( $@, qr/^prompt function called without an argument/, 29*0Sstevel@tonic-gate 'undef message' ); 30*0Sstevel@tonic-gate 31*0Sstevel@tonic-gatemy $stdout = tie *STDOUT, 'TieOut' or die; 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate$ENV{PERL_MM_USE_DEFAULT} = 1; 35*0Sstevel@tonic-gateis( prompt("Foo?"), '', 'no default' ); 36*0Sstevel@tonic-gatelike( $stdout->read, qr/^Foo\?\s*\n$/, ' question' ); 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gateis( prompt("Foo?", undef), '', 'undef default' ); 39*0Sstevel@tonic-gatelike( $stdout->read, qr/^Foo\?\s*\n$/, ' question' ); 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gateis( prompt("Foo?", 'Bar!'), 'Bar!', 'default' ); 42*0Sstevel@tonic-gatelike( $stdout->read, qr/^Foo\? \[Bar!\]\s+Bar!\n$/, ' question' ); 43*0Sstevel@tonic-gate 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gateSKIP: { 46*0Sstevel@tonic-gate skip "eof() doesn't honor ties in 5.5.3", 3 if $] < 5.006; 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gate $ENV{PERL_MM_USE_DEFAULT} = 0; 49*0Sstevel@tonic-gate close STDIN; 50*0Sstevel@tonic-gate my $stdin = tie *STDIN, 'TieIn' or die; 51*0Sstevel@tonic-gate $stdin->write("From STDIN"); 52*0Sstevel@tonic-gate ok( !-t STDIN, 'STDIN not a tty' ); 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate is( prompt("Foo?", 'Bar!'), 'From STDIN', 'from STDIN' ); 55*0Sstevel@tonic-gate like( $stdout->read, qr/^Foo\? \[Bar!\]\s*$/, ' question' ); 56*0Sstevel@tonic-gate} 57