The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Sweet::Keyword::Test;
BEGIN {
  $Test::Sweet::Keyword::Test::VERSION = '0.03';
}
# ABSTRACT: provides the C<test> keyword
use strict;
use warnings;

use Devel::Declare ();
use Sub::Name;

use base 'Devel::Declare::Context::Simple';

sub install_methodhandler {
    my $class = shift;
    my %args  = @_;
    {
        no strict 'refs';
        *{$args{into}.'::test'} = sub (&) {};
    }

    my $ctx = $class->new(%args);
    Devel::Declare->setup_for(
        $args{into}, {
            test => { const => sub { $ctx->parser(@_) } },
        }
    );
}

sub parse_proto {
    my ($self, $proto) = @_;
    # todo: warn about bad syntax
    return [ grep { /[A-Za-z]+/} split /[^:_A-Za-z0-9+]+/, $proto ];
}

sub parser {
    my $self = shift;
    $self->init(@_);

    $self->skip_declarator;
    my $name = $self->strip_name;
    my $raw_proto = $self->strip_proto || '';
    my $attrs = $self->strip_attrs || '';
    my $requested_traits = $self->parse_proto($raw_proto . ' '. $attrs); # why not let attrs be used too?

    my $inject = $self->scope_injector_call();
    $self->inject_if_block($inject. " my \$self = shift; my \$test = shift; ");

    my $pack = Devel::Declare::get_curstash_name;
    Devel::Declare::shadow_sub("${pack}::test", sub (&) {
        my $test_method = shift;
        $pack->meta->add_test( $name, $test_method, $requested_traits );
    });

    return;
}

1;



=pod

=head1 NAME

Test::Sweet::Keyword::Test - provides the C<test> keyword

=head1 VERSION

version 0.03

=head1 AUTHOR

Jonathan Rockway <jrockway@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Jonathan Rockway.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__