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