The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

package Test::StructuredObject::TestSuite;
BEGIN {
  $Test::StructuredObject::TestSuite::AUTHORITY = 'cpan:KENTNL';
}
{
  $Test::StructuredObject::TestSuite::VERSION = '0.01000010';
}

# ABSTRACT: A collection of tests in an order waiting to be executed.

use Moose;
use Carp qw( croak );
use namespace::autoclean;

use Test::More;
extends 'Test::StructuredObject::CodeStub';


has items => ( isa => 'ArrayRef', required => 1, is => 'rw' );
around BUILDARGS => sub {
  my ( $orig, $class ) = ( shift, shift );
  if ( ref $_[0] ) {
    return $class->$orig( items => \@_ );
  }
  return $class->$orig(@_);
};

sub name { return 'unnamed toplevel testsuite' }

sub _run_items {
  my $self = shift;
  plan tests => scalar grep { !$_->isa('Test::StructuredObject::NonTest') } @{ $self->items };
  return [ map { $_->run() } @{ $self->items } ];
}


sub run {
  my $self = shift;
  return $self->_run_items;
}

sub _label {
  my $self = shift;
  return __PACKAGE__ . '(' . shift . ')';
}

sub _gen_note_sub {
  my ( $pfix, $self, $test ) = @_;
  my $name    = $self->name;
  my $subname = $test->name;
  my $code;

  ## no critic ( ProhibitStringyEval , ProhibitPunctuationVars )
  eval( 'package Test::StructuredObject::TestSuite::linearize_note_eval;'
      . 'use Test::More;'
      . "\$code = sub{ note(q{ $pfix Linearized Subtest $name / $subname }) }; 1 " )
    or croak($@);
  return Test::StructuredObject::NonTest->new( code => $code );
}


sub linearize {
  my $self = shift;
  my @items;
  for my $test ( @{ $self->items } ) {
    if ( $test->isa('Test::StructuredObject::TestSuite') ) {
      push @items, _gen_note_sub( 'Running', $self, $test );
      push @items, @{ $test->linearize->items };
      push @items, _gen_note_sub( 'Ending',  $self, $test );

      next;
    }
    push @items, $test;
  }
  return Test::StructuredObject::TestSuite->new( items => \@items );
}


sub to_s {
  my $self = shift;
  my $i    = 0;
  return $self->_label(
    join q{,},
    map { ( $_->isa('Test::StructuredObject::NonTest') ? "\n#step\n" : "\n#test " . ++$i . "\n" ) . $_->to_s } @{ $self->items }
  );
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=head1 NAME

Test::StructuredObject::TestSuite - A collection of tests in an order waiting to be executed.

=head1 VERSION

version 0.01000010

=head1 METHODS

=head2 name

Simply  returns the string to use inside C<linearize>'d C<TestSuite>s.

=head2 C<run>

execute each one of C<< $self->items >>

=head2 C<linearize>

Flatten all nested subsets to produce a C<TestSuite> containing only C<Test> and C<NonTest> entries.

This  is handy for backwards compatibility with older C<Test::More> instances.

=head2 C<to_s>

pretty-print ( Serialisation-like ) a string representation of this object in a recursive way.

Handy for seeing the internal representation of the prepared test.

=head1 ATTRIBUTES

=head2 C<items>

An array of testable items.

=head1 AUTHOR

Kent Fredric <kentnl@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Kent Fredric <kentnl@cpan.org>.

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