Just when you thought it was safe to smoke Perl... I'm also working on tests for CPAN::FirstTime, though they may require a bit of reorganization to do it right. It'll likely make the code smaller and more flexible too.
-- c --- MANIFEST~ Thu May 9 19:04:21 2002 +++ MANIFEST Thu May 9 19:06:06 2002 @@ -88,6 +88,7 @@ ext/B/Makefile.PL Compiler backend makefile writer ext/B/NOTES Compiler backend notes ext/B/O.pm Compiler front-end module (-MO=...) +ext/B/t/o.t See if O works ext/B/ramblings/cc.notes Compiler ramblings: notes on CC backend ext/B/ramblings/curcop.runtime Compiler ramblings: notes on curcop use ext/B/ramblings/flip-flop Compiler ramblings: notes on flip-flop --- /dev/null Thu Aug 30 02:54:37 2001 +++ ext/B/t/o.t Thu May 9 19:03:25 2002 @@ -0,0 +1,59 @@ +#!./perl -w + +use strict; + +BEGIN { + chdir 't' if -d 't'; + @INC = ('../lib', 'lib', '.'); + require 'test.pl'; +} + +local *OUT; +open(OUT, '>lib/B/success.pm') or skip_all( 'Cannot write fake backend module'); +print OUT while <DATA>; +close *OUT; + +plan( 9 ); + +# use() makes it difficult to avoid O::import() +require_ok( 'O' ); + +my @args = ('-Ilib', '-MO=success,foo,bar', '-e', '1' ); +my $foo = runperl( args => \@args, stderr => 1 ); + +my @lines = split(/\n/, $foo); +is( $lines[0], '-e syntax OK', 'O.pm should not munge perl output without -qq'); +is( $lines[1], 'Compiling!', 'Output should not be saved without -q switch' ); +is( $lines[2], '(foo) <bar>', 'O.pm should call backend compile() method' ); +is( $lines[3], '[]', 'Nothing should be in $O::BEGIN_output without -q' ); + +$args[1] = '-MO=-q,success,foo,bar'; +@lines = split(/\n/, runperl( args => \@args, stderr => 1 ) ); +isnt( $lines[1], 'Compiling!', 'Output should not be printed with -q switch' ); +is( $lines[2], "[Compiling!", '... but should be in $O::BEGIN_output' ); + +$args[1] = '-MO=-qq,success,foo,bar'; +@lines = split(/\n/, runperl( args => \@args, stderr => 1 )); +is( scalar @lines, 3, '-qq should suppress even the syntax OK message' ); + +$args[1] = '-MO=success,fail'; +@lines = split(/\n/, runperl( args => \@args, stderr => 1 )); +like( $lines[0], qr/fail at .eval/, + 'O.pm should die if backend compile() does not return a subref' ); + +END { + 1 while unlink('lib/B/success.pm'); +} + +__END__ +package B::success; + +print "Compiling!\n"; + +sub compile { + return 'fail' if ($_[0] eq 'fail'); + print "($_[0]) <$_[1]>\n"; + return sub { print "[$O::BEGIN_output]\n" }; +} + +1;