BEGIN { # Magic Perl CORE pragma if ($ENV{PERL_CORE}) { chdir 't' if -d 't'; @INC = '../lib'; } } # set up tests to do use Test::More tests => 2 + 1 + 2 + 2 + 2 + 1; # strict and verbose as possible use strict; use warnings; # set up source to check my $module = 'Foo'; my $source = <<"SRC"; all #PERSONA one one only #PERSONA one two one and two #PERSONA !one not one #PERSONA all again __END__ #PERSONA one one never #PERSONA all never SRC # make sure we have it as a file my $filename = "$module.pm"; open( my $out, '>', $filename ) or die "Could not open $filename: $!"; my $written = print $out $source; ok( $written, "could write file $filename" ); ok( close($out), "flushed ok to disk" ); # always slurp $/ = undef; # set up string components my $prefix = qq/$^X -Ilib -Mpersona -e 'print scalar \${ persona->path2source("$filename/; my $postfix = qq/") }' 2>&1 |/; # no persona open( $out, "$prefix$postfix" ); is( readline($out), $source, 'no persona, no interference' ); # persona zero foreach ( '', qq{","zero} ) { local $ENV{PERSONA} = $_ ? '' : 'zero'; open( $out, "$prefix$_$postfix" ); is( readline($out), <<'OK', 'PERSONA zero' ); all #line 7 Foo.pm (allowed by persona 'zero') not one #PERSONA all again __END__ #PERSONA one one never #PERSONA all never OK } # persona one foreach ( '', qq{","one} ) { local $ENV{PERSONA} = $_ ? '' : 'one'; open( $out, "$prefix$_$postfix" ); is( readline($out), <<'OK', 'PERSONA one' ); all #PERSONA one one only #PERSONA one two one and two #line 9 Foo.pm (all personas) all again __END__ #PERSONA one one never #PERSONA all never OK } # persona two foreach ( '', qq{","two} ) { local $ENV{PERSONA} = $_ ? '' : 'two'; open( $out, "$prefix$_$postfix" ); is( readline($out), <<'OK', 'PERSONA two' ); all #line 5 Foo.pm (allowed by persona 'two') one and two #PERSONA !one not one #PERSONA all again __END__ #PERSONA one one never #PERSONA all never OK } # we're done ok( unlink($filename), 'remove module' );