Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Progress

  • Loading branch information...
commit 10c729de6cdf7455eaf566744c5afe60a731fe73 1 parent 9dc7994
@exodist authored
View
4 GOALS.TXT → GOALS
@@ -11,7 +11,7 @@
== Secondary Goals ==
- * Test groups (test-workflow)
+ * Test groups (Test-Workflow)
* Case workflow
* SPEC workflow
- * Easy mocking
+ * Easy mocking (Object-Quick)
View
5 TODO
@@ -0,0 +1,5 @@
+ * Mocking - Object::Quick
+ * Workflows - Test::Workflow
+
+ * Defaults + use Fennec params (They are not merged properly)
+ * Allow params to defaults/import utils
View
3  lib/Fennec.pm
@@ -6,9 +6,8 @@ use Fennec::Util qw/inject_sub/;
sub defaults {(
utils => [qw/
- Test::More Test::Warn Test::Exception
+ Test::More Test::Warn Test::Exception Test::Workflow
/],
- #Test::Workflow Test::Workflow::Spec Test::Workflow::Case
parallel => 0,
runner => 'Fennec::Runner',
)}
View
1  lib/Fennec/Handler/TAP.pm
@@ -5,7 +5,6 @@ use warnings;
use Fennec::Util qw/accessors/;
use TAP::Parser;
use POSIX ":sys_wait_h";
-use Data::Dumper;
accessors qw/buffer ready/;
View
1  lib/Fennec/IO/Handle.pm
@@ -2,7 +2,6 @@ package Fennec::IO::Handle;
use strict;
use warnings;
-use Data::Dumper;
use Fennec::Util qw/accessors/;
accessors qw/prefix/;
View
66 lib/Test/Workflow.pm
@@ -0,0 +1,66 @@
+package Test::Workflow;
+use strict;
+use warnings;
+
+use Exporter::Declare;
+use Test::Workflow::Meta;
+
+default_exports qw/
+ tests run_tests
+ describe it
+ cases case
+ before_each after_each
+ before_all after_all
+ with_tests
+/;
+
+gen_default_export TEST_WORKFLOW => sub {
+ my ( $class, $importer ) = @_;
+ my $meta = Test::Workflow::Meta->new($importer);
+ return sub { $meta };
+};
+
+{ no warnings 'once'; @DB::CARP_NOT = qw/ DB Test::Workflow /}
+sub _get_layer {
+ package DB;
+ use Carp qw/croak/;
+ use Scalar::Util qw/blessed/;
+
+ my ($caller) = @_;
+
+ my @parent = caller(2);
+ my @pargs = @DB::args;
+ my $state = $pargs[-1];
+
+ return $state if blessed($state)
+ && blessed($state)->isa( 'Test::Workflow::State' );
+
+ my $meta = $caller->[0]->TEST_WORKFLOW;
+ croak "Could not find state, did you modify \@_?"
+ if $meta->build_complete;
+
+ return $meta->ROOT_LAYER;
+}
+
+sub with_tests { my @caller = caller; _get_layer( \@caller )->merge_in( \@caller, @_ )}
+
+sub tests { my @caller = caller; _get_layer( \@caller )->add_test( \@caller, @_ )}
+sub it { my @caller = caller; _get_layer( \@caller )->add_test( \@caller, @_ )}
+sub case { my @caller = caller; _get_layer( \@caller )->add_case( \@caller, @_ )}
+
+sub describe { my @caller = caller; _get_layer( \@caller )->add_child( \@caller, @_ )}
+sub cases { my @caller = caller; _get_layer( \@caller )->add_child( \@caller, @_ )}
+
+sub before_each { my @caller = caller; _get_layer( \@caller )->add_before_each( \@caller, @_ )}
+sub before_all { my @caller = caller; _get_layer( \@caller )->add_before_all( \@caller, @_ )}
+sub after_each { my @caller = caller; _get_layer( \@caller )->add_after_each( \@caller, @_ )}
+sub after_all { my @caller = caller; _get_layer( \@caller )->add_after_all( \@caller, @_ )}
+
+sub run_tests {
+ my ( $instance ) = @_;
+ my $layer = $instance->TEST_WORKFLOW->ROOT_LAYER;
+ my @tests = get_tests( $instance, $layer );
+
+}
+
+1;
View
32 lib/Test/Workflow/Block.pm
@@ -0,0 +1,32 @@
+package Test::Workflow::Block;
+use strict;
+use warnings;
+
+use Fennec::Util qw/accessors/;
+use Carp qw/croak/;
+
+our @CARP_NOT = qw/
+ Test::Workflow
+ Test::Workflow::Meta
+ Test::Workflow::Block
+ Test::Workflow::Layer
+/;
+
+accessors qw/ name start_line end_line code /;
+
+sub new {
+ my $class = shift;
+ my ( $caller, $name, $code ) = @_;
+
+ croak "You must provide a name" unless $name and !ref $name;
+ croak "You must provide a codeblock" unless $code && ref $code eq 'CODE';
+
+ return bless({
+ name => $name,
+ code => $code,
+ end_line => $caller->[3],
+ start_line => B::svref_2object( $code )->START->line,
+ }, $class);
+}
+
+1;
View
56 lib/Test/Workflow/Layer.pm
@@ -0,0 +1,56 @@
+package Test::Workflow::Layer;
+use strict;
+use warnings;
+
+use Test::Workflow::Block;
+
+use Fennec::Util qw/accessors/;
+use Scalar::Util qw/blessed/;
+use Carp qw/croak/;
+
+our @ATTRIBUTES = qw/
+ test
+ case
+ child
+ before_each
+ before_all
+ after_each
+ after_all
+/;
+
+accessors @ATTRIBUTES;
+
+sub new { bless({ map {( $_ => [] )} @ATTRIBUTES }, shift )}
+
+sub clone {
+ my $self = shift;
+ my $class = blessed( $self );
+ my $new = bless( { %{$self} }, $class );
+ return $new;
+}
+
+sub merge_in {
+ my $self = shift;
+ my ( $add ) = @_;
+ push @{ $self->$_ } => @{ $add->$_ } for @ATTRIBUTES;
+}
+
+for my $type ( qw/test case child before_each before_all after_each after_all/ ) {
+ my $add = sub {
+ my $self = shift;
+ push @{ $self->$type } => Test::Workflow::Block->new( @_ );
+ };
+ no strict 'refs';
+ *{"add_$type"} = $add;
+}
+
+sub get_all {
+ my $self = shift;
+ my ( $type ) = @_;
+ return @{ $self->$type }
+ if $self->can( $type );
+
+ croak "No such type: $type";
+}
+
+1;
View
20 lib/Test/Workflow/Meta.pm
@@ -0,0 +1,20 @@
+package Test::Workflow::Meta;
+use strict;
+use warnings;
+
+use Test::Workflow::Layer;
+
+use Fennec::Util qw/accessors array_accessors/;
+
+accessors qw/test_class build_complete root_layer/;
+
+sub new {
+ my $class = shift;
+ my ( $test_class ) = @_;
+ return bless({
+ test_class => $test_class,
+ root_layer => Test::Workflow::Layer->new(),
+ }, $class );
+}
+
+1;
View
15 t/test_workflow_initital.t
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+package XXX;
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Workflow;
+
+tests outer => sub {
+ tests inner => sub {
+
+ };
+};
+
+done_testing();
Please sign in to comment.
Something went wrong with that request. Please try again.