1#!./perl -w 2 3BEGIN { 4 if ($ENV{PERL_CORE}){ 5 chdir('t') if -d 't'; 6 @INC = ('.', 'lib', '../lib'); 7 } else { 8 unshift @INC, 't'; 9 push @INC, "../../t"; 10 } 11 require Config; 12 if (($Config::Config{'extensions'} !~ /\bB\b/) ){ 13 print "1..0 # Skip -- Perl configured without B module\n"; 14 exit 0; 15 } 16 require 'test.pl'; 17} 18 19use strict; 20use Config; 21use File::Spec; 22use File::Path; 23 24my $path = File::Spec->catdir( 'lib', 'B' ); 25unless (-d $path) { 26 mkpath( $path ) or skip_all( 'Cannot create fake module path' ); 27} 28 29my $file = File::Spec->catfile( $path, 'success.pm' ); 30local *OUT; 31open(OUT, '>', $file) or skip_all( 'Cannot write fake backend module'); 32print OUT while <DATA>; 33close *OUT; 34 35plan( 9 ); # And someone's responsible. 36 37# use() makes it difficult to avoid O::import() 38require_ok( 'O' ); 39 40my @args = ('-Ilib', '-MO=success,foo,bar', '-e', '1' ); 41my @lines = get_lines( @args ); 42 43is( $lines[0], 'Compiling!', 'Output should not be saved without -q switch' ); 44is( $lines[1], '(foo) <bar>', 'O.pm should call backend compile() method' ); 45is( $lines[2], '[]', 'Nothing should be in $O::BEGIN_output without -q' ); 46is( $lines[3], '-e syntax OK', 'O.pm should not munge perl output without -qq'); 47 48$args[1] = '-MO=-q,success,foo,bar'; 49@lines = get_lines( @args ); 50isnt( $lines[1], 'Compiling!', 'Output should not be printed with -q switch' ); 51 52SKIP: { 53 skip( '-q redirection does not work without PerlIO', 2) 54 unless $Config{useperlio}; 55 is( $lines[1], "[Compiling!", '... but should be in $O::BEGIN_output' ); 56 57 $args[1] = '-MO=-qq,success,foo,bar'; 58 @lines = get_lines( @args ); 59 is( scalar @lines, 3, '-qq should suppress even the syntax OK message' ); 60} 61 62$args[1] = '-MO=success,fail'; 63@lines = get_lines( @args ); 64like( $lines[1], qr/fail at .eval/, 65 'O.pm should die if backend compile() does not return a subref' ); 66 67sub get_lines { 68 split(/[\r\n]+/, runperl( args => [ @_ ], stderr => 1 )); 69} 70 71END { 72 1 while unlink($file); 73 rmdir($path); # not "1 while" since there might be more in there 74} 75 76__END__ 77package B::success; 78 79$| = 1; 80print "Compiling!\n"; 81 82sub compile { 83 return 'fail' if ($_[0] eq 'fail'); 84 print "($_[0]) <$_[1]>\n"; 85 return sub { print "[$O::BEGIN_output]\n" }; 86} 87 881; 89