Skip to content

Commit

Permalink
Merge pull request pherkin#116 from pjlsergeant/tap-source
Browse files Browse the repository at this point in the history
Merge tap-source branch to master
  • Loading branch information
Peter Sergeant committed Feb 7, 2017
2 parents 79e8e10 + d909926 commit 0fc57bd
Show file tree
Hide file tree
Showing 8 changed files with 273 additions and 88 deletions.
Expand Up @@ -29,5 +29,5 @@
'hex' => 'hexdigest'
}->{$type};

is( S->{'object'}->$method, $expected );
is( S->{'object'}->$method, $expected );
};
105 changes: 54 additions & 51 deletions lib/App/pherkin.pm
Expand Up @@ -15,7 +15,7 @@ use File::Spec;
use Path::Class qw/file dir/;

use Test::BDD::Cucumber::I18n
qw(languages langdef readable_keywords keyword_to_subname);
qw(languages langdef readable_keywords keyword_to_subname);
use Test::BDD::Cucumber::Loader;

use Moose;
Expand Down Expand Up @@ -58,10 +58,11 @@ Returns a L<Test::BDD::Cucumber::Model::Result> object for all steps run.
=cut

sub run {
sub _pre_run {
my ( $self, @arguments ) = @_;

# localized features will have utf8 in them and options may output utf8 as well
# localized features will have utf8 in them and options may output utf8 as
# well
binmode STDOUT, ':utf8';

my ($features_path) = $self->_process_arguments(@arguments);
Expand All @@ -74,8 +75,14 @@ sub run {
$executor->add_extensions($_) for @{ $self->extensions };

Test::BDD::Cucumber::Loader->load_steps( $executor, $_ )
for @{ $self->step_paths };
for @{ $self->step_paths };

return ( $executor, @features );
}

sub run {
my ( $self, @arguments ) = @_;
my ( $executor, @features ) = $self->_pre_run(@arguments);
return $self->_run_tests( $executor, @features );
}

Expand Down Expand Up @@ -107,7 +114,7 @@ sub _initialize_harness {
}

eval { use_module($harness_module) }
|| die "Unable to load harness [$harness_module]: $@";
|| die "Unable to load harness [$harness_module]: $@";

$self->harness( $harness_module->new() );
}
Expand All @@ -124,18 +131,16 @@ sub _find_config_file {
map { ( "$_.yaml", "$_.yml" ) } (

# Relative locations
(
map { file($_) }
qw!.pherkin config/pherkin ./.config/pherkin t/.pherkin!
( map { file($_) }
qw!.pherkin config/pherkin ./.config/pherkin t/.pherkin!
),

# Home locations
(
map { dir($_)->file('.pherkin') }
grep { $_ } map { $ENV{$_} } qw/HOME USERPROFILE/
( map { dir($_)->file('.pherkin') }
grep {$_} map { $ENV{$_} } qw/HOME USERPROFILE/
)
)
)
)
{
return $_ if -f $_;
print "No config file found in $_\n" if $debug;
Expand All @@ -146,8 +151,8 @@ sub _find_config_file {
sub _load_config {
my ( $self, $profile_name, $proposed_config_filename, $debug ) = @_;

my $config_filename =
$self->_find_config_file( $proposed_config_filename, $debug );
my $config_filename
= $self->_find_config_file( $proposed_config_filename, $debug );
my $config_data_whole;

# Check we can actually load some data from that file if required
Expand All @@ -158,10 +163,10 @@ sub _load_config {
if ($profile_name) {
print "No configuration files found\n" if $debug;
die
"Profile name [$profile_name] specified, but no configuration file found (use --debug-profiles to debug)";
"Profile name [$profile_name] specified, but no configuration file found (use --debug-profiles to debug)";
} else {
print "No configuration files found, and no profile specified\n"
if $debug;
if $debug;
return;
}
}
Expand All @@ -171,13 +176,13 @@ sub _load_config {
# Check the config file has the right type of data at the profile name
unless ( ref $config_data_whole eq 'HASH' ) {
die
"Config file [$config_filename] doesn't return a hashref on parse, instead a ["
. ref($config_data_whole) . ']';
"Config file [$config_filename] doesn't return a hashref on parse, instead a ["
. ref($config_data_whole) . ']';
}
my $config_data = $config_data_whole->{$profile_name};
my $profile_problem = sub {
return "Config file [$config_filename] profile [$profile_name]: "
. shift();
. shift();
};
unless ($config_data) {
die $profile_problem->("Profile not found");
Expand All @@ -195,14 +200,14 @@ sub _load_config {
if ( my $reftype = ref $value ) {
if ( $key ne 'extensions' ) {
die $profile_problem->(
"Option $key is a [$reftype] but can only be a single value or ARRAY"
"Option $key is a [$reftype] but can only be a single value or ARRAY"
) unless $reftype eq 'ARRAY';
push( @arguments, $key, $_ ) for @$value;
} else {
die $profile_problem->(
"Option $key is a [$reftype] but can only be a HASH as '$key' is"
. " a special case - see the documentation for details")
unless $reftype eq 'HASH' && $key eq 'extensions';
"Option $key is a [$reftype] but can only be a HASH as '$key' is"
. " a special case - see the documentation for details"
) unless $reftype eq 'HASH' && $key eq 'extensions';
push( @arguments, $key, $value );
}
} else {
Expand Down Expand Up @@ -275,14 +280,14 @@ sub _process_arguments {

# Load the configuration file
my @configuration_options = $self->_load_config( map { $deref->($_) }
qw/profile config debug_profiles/ );
qw/profile config debug_profiles/ );

# Merge those configuration items
# First we need a list of matching keys
my %keys = map {
my ( $key_basis, $ref ) = @{ $options{$_} };
map { $_ => $ref }
map { s/=.+//; $_ } ( split( /\|/, $key_basis ), $_ );
map { s/=.+//; $_ } ( split( /\|/, $key_basis ), $_ );
} keys %options;

# Now let's go through each option. For arrays, we want the configuration
Expand All @@ -295,38 +300,37 @@ sub _process_arguments {
my ($value) = shift(@configuration_options);
my $target = $keys{$key} || die "Unknown configuration option [$key]";

if ( $key eq 'extensions' || $key eq 'extension' )
{
if ( $key eq 'extensions' || $key eq 'extension' ) {
die "Value of $key in config file expected to be HASH but isn't"
if ref $value ne 'HASH';

# if the configuration of the extension is 'undef', then
# none was defined. Replace it with an empty hashref, which
# is what Moose's 'new()' method wants later on
my @e = map { [ $_, [ $value->{$_} || { } ] ] } keys %$value;
my @e = map { [ $_, [ $value->{$_} || {} ] ] } keys %$value;
$value = \@e;
my $array = $additions{ 0 + $target } ||= [];
push( @$array, @$value );
print "Adding extensions near the front of $key"
if $deref->('debug_profiles');
if $deref->('debug_profiles');
} elsif ( ref $target ne 'ARRAY' ) {

# Only use it if we don't have something already
if ( defined $$target ) {
print
"Ignoring $key from config file because set on cmd line as $$target\n"
if $deref->('debug_profiles');
"Ignoring $key from config file because set on cmd line as $$target\n"
if $deref->('debug_profiles');
} else {
$$target = $value;
print "Set $key to $target from config file\n"
if $deref->('debug_profiles');
if $deref->('debug_profiles');
}

} else {
my $array = $additions{ 0 + $target } ||= [];
push( @$array, $value );
print "Adding $value near the front of $key\n"
if $deref->('debug_profiles');
if $deref->('debug_profiles');
}
}
for my $target ( values %options ) {
Expand Down Expand Up @@ -357,7 +361,7 @@ sub _process_arguments {

unshift @{ $deref->('includes') }, 'lib' if $deref->('lib');
unshift @{ $deref->('includes') }, 'blib/lib', 'blib/arch'
if $deref->('blib');
if $deref->('blib');

# We may need some of the imported paths...
lib->import( @{ $deref->('includes') } );
Expand All @@ -370,11 +374,10 @@ sub _process_arguments {
my $instance = $c->new(@$a);
push( @{ $self->extensions }, $instance );

my $dir = file($INC{module_notional_filename($c)})->dir;
my @step_dirs =
map { File::Spec->rel2abs( $_, $dir ) }
@{$instance->step_directories};
unshift( @{$deref->('steps')}, @step_dirs );
my $dir = file( $INC{ module_notional_filename($c) } )->dir;
my @step_dirs = map { File::Spec->rel2abs( $_, $dir ) }
@{ $instance->step_directories };
unshift( @{ $deref->('steps') }, @step_dirs );
}

# Munge the output harness
Expand Down Expand Up @@ -429,14 +432,14 @@ sub _print_languages {

my @languages = languages();

my $max_code_length = max map { length } @languages;
my $max_name_length =
max map { length( langdef($_)->{name} ) } @languages;
my $max_native_length =
max map { length( langdef($_)->{native} ) } @languages;
my $max_code_length = max map {length} @languages;
my $max_name_length
= max map { length( langdef($_)->{name} ) } @languages;
my $max_native_length
= max map { length( langdef($_)->{native} ) } @languages;

my $format =
"| %-${max_code_length}s | %-${max_name_length}s | %-${max_native_length}s |\n";
my $format
= "| %-${max_code_length}s | %-${max_name_length}s | %-${max_native_length}s |\n";

for my $language ( sort @languages ) {
my $langdef = langdef($language);
Expand All @@ -451,23 +454,23 @@ sub _print_langdef {
my $langdef = langdef($language);

my @keywords = qw(feature background scenario scenario_outline examples
given when then and but);
my $max_length =
max map { length readable_keywords( $langdef->{$_} ) } @keywords;
given when then and but);
my $max_length
= max map { length readable_keywords( $langdef->{$_} ) } @keywords;

my $format = "| %-16s | %-${max_length}s |\n";
for my $keyword (
qw(feature background scenario scenario_outline
examples given when then and but )
)
)
{
printf $format, $keyword, readable_keywords( $langdef->{$keyword} );
}

my $codeformat = "| %-16s | %-${max_length}s |\n";
for my $keyword (qw(given when then )) {
printf $codeformat, $keyword . ' (code)',
readable_keywords( $langdef->{$keyword}, \&keyword_to_subname );
readable_keywords( $langdef->{$keyword}, \&keyword_to_subname );
}

exit;
Expand Down
108 changes: 108 additions & 0 deletions lib/TAP/Parser/SourceHandler/Feature.pm
@@ -0,0 +1,108 @@
package TAP::Parser::SourceHandler::Feature;

use strict;
use warnings;

use Path::Class qw/file/;

use base 'TAP::Parser::SourceHandler';

use TAP::Parser::Iterator::Stream;

use App::pherkin;

use Test::BDD::Cucumber::Loader;
use Test::BDD::Cucumber::Harness::TestBuilder;

use Path::Class qw/file/;

TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);

sub can_handle {
my ( $class, $source ) = @_;

#use Data::Printer; p $source;

if ( $source->meta->{'is_file'}
&& $source->meta->{'file'}->{'basename'} =~ m/\.feature$/ )
{

my $dir = $source->meta->{'file'}->{'dir'};
unless ( $source->{'pherkins'}->{$dir} ) {

my $pherkin = App::pherkin->new();

# Reformulate before passing to the cmd line parser
my @cmd_line;
my %options = %{ $source->config_for($class) };
while ( my ( $key, $value ) = each %options ) {

# Nasty hack
if ( length $key > 1 ) {
push( @cmd_line, "--$key", $value );
} else {
push( @cmd_line, "-$key", $value );
}
}

my ( $executor, @features )
= $pherkin->_pre_run( @cmd_line, $dir );

$source->{'pherkins'}->{$dir} = {
pherkin => $pherkin,
executor => $executor,
features => {
map { ( file( $_->document->filename ) . '' ) => $_ }
@features
}
};
}
return 1;
}

return 0;
}

sub make_iterator {
my ( $class, $source ) = @_;

my ( $input_fh, $output_fh );
pipe $input_fh, $output_fh;

my $tb = Test::Builder->create();
$tb->output($output_fh);

my $pid = fork;
if ($pid) {
close $output_fh;
return TAP::Parser::Iterator::Stream->new($input_fh);
}

close $input_fh;
my $harness = Test::BDD::Cucumber::Harness::TestBuilder->new(
{ fail_skip => 1,
_tb_instance => $tb,
}
);

my $dir = $source->meta->{'file'}->{'dir'};
my $runtime = $source->{'pherkins'}->{$dir}
|| die "No pherkin instantiation for [$dir]";

my $executor = $runtime->{'executor'};
my $pherkin = $runtime->{'pherkin'};
$pherkin->harness($harness);

my $filename = file( $dir . $source->meta->{'file'}->{'basename'} ) . '';

my $feature = $runtime->{'features'}->{$filename}
|| die "Feature not pre-loaded: [$filename]; have: "
. ( join '; ', keys %{ $runtime->{'features'} } );

$pherkin->_run_tests( $executor, $feature );

close $output_fh;
exit;
}

1;

0 comments on commit 0fc57bd

Please sign in to comment.