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