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