#!/usr/bin/perl

use strict;
use warnings;

use lib '../../lib', '../../';

use Perl6::MetaModel;
use Carp 'confess';
use Scalar::Util 'blessed';

$::TestBuilder = undef;

$::TestBuilder = class 'TestBuilder' => {
    is => [ $::Object ],
    class_attributes => [
        '$:singleton',    
    ],
    attributes => [
        '$.output',
        '$.testplan',
        '@:results',
    ],
    class_methods => {
        'new'    => sub { 
            my ($class, $plan, $output) = @_;
            __('$:singleton' => $::CLASS->new('$.testplan' => $plan, '$.output'   => $output)) 
                unless defined __('$:singleton');
            __('$:singleton');
        },
        'create' => sub { shift; $::CLASS->new(@_) }        
    },
    submethods => {
        'BUILD' => sub {
            _('$.output' => $::TestBuilder->FETCH('::Output')->new());
        },
        'DESTROY' => sub {
            my $footer = _('$.testplan')->footer( scalar @{_('@:results')} );
            _('$.output')->write($footer) if $footer;            
        }
    },
    methods => {
        'get_test_number' => sub { scalar(@{_('@:results')}) + 1 },
        'testplan' => sub { _('$.testplan') },
        'plan' => sub {
            my ($self, $explanation, $tests) = @_;
            confess "Plan already set!" if _('$.testplan');
            if ($tests) {
                _('$.testplan' => $::TestBuilder->FETCH('::TestPlan')->new( '$.expect' => $tests ));
            }
            elsif ($explanation eq 'no_plan') {
                _('$.testplan' => $::TestBuilder->FETCH('::NullPlan')->new());
            }
            else {
                confess "Unknown plan";
            }
            _('$.output')->write(_('$.testplan')->header());            
        },
        'ok' => sub { 
            my ($self, $passed, $description) = @_;
            $description ||= '';
            $self->report_test(
                $::TestBuilder->FETCH('::Test')->new(
                    '$.number'      => $self->get_test_number(),
                    '$.passed'      =>  $passed,
                    '$.description' =>  $description,
                )
            );
            return $passed;
        },
        'diag' => sub {
            my ($self, $diagnostic) = @_;
            $diagnostic ||= '';            
            _('$.output')->diag($diagnostic);
        },
        'todo' => sub { 
            my ($self, $passed, $description, $reason) = @_;
            $self->report_test(
                $::TestBuilder->FETCH('::Test')->new(
                    '$.todo'        => 1,
                    '$.number'      => $self->get_test_number(),
                    '$.reason'      =>  $reason,
                    '$.description' =>  $description,
                )
            );
            return $passed;
        },        
        'skip' => sub { 
            my ($self, $num, $reason) = @_;
            $num ||= 1;
            $reason ||= 'skipped';
            for (1 .. $num) {
                $self->report_test(
                    $::TestBuilder->FETCH('::Test')->new(
                        '$.skip'   => 1,
                        '$.number' => $self->get_test_number(),
                        '$.reason' =>  $reason,
                    )
                );
            }
        },        
        'skip_all' => sub {
            confess 'Cannot skill_all with a plan' if defined _('$.testplan');
            _('$.output')->write('1..0');
            exit 0;
        },
        'BAILOUT' => sub {
            my ($self, $reason) = @_;
            $reason ||= '';
            _('$.output')->write("Bail out!  $reason");
            exit 255;
        },
        'report_test' => sub {
            my ($self, $test) = @_;
            (blessed($test) && $test->isa('TestBuilder::Test'))
                || confess "test argument must be a TestBuilder::Test instance";
            confess 'No plan set!' unless _('$.testplan');
            push @{_('@:results')} => $test;
            _('$.output')->write( $test->report() );
        }
    }
};

require "lib/TestBuilder/TestPlan.pm";
require "lib/TestBuilder/Output.pm";
require "lib/TestBuilder/Test.pm";

1;

__END__

=pod

=head1 NAME

Test::Builder - Backend for building test libraries

=head1 SYNOPSIS

  module My::Test::Module;

  use Test::Builder;
  use Test::Builder::Output;

  my Test::Builder $Test .= new(
        output => Test::Builder::Output.new(
           error_output => open('my_error_log_file')
        )
    );

  sub plan (Str $explanation?, Int $tests?) is export {
     $Test.testplan($explanation, $tests);
  }

  sub ok ($passed, $description?, $todo?) is export {
     if $todo {
        $Test.todo($passed, $description, $todo) 
            || $Test.diag("FAILED : $description");
     }
     else {
        $Test.ok($passed, $description)
            || $Test.diag("FAILED : $description");
     }
  }

  sub is ($got, $expected, $description?, $todo?) is export {
     if $todo {
        $Test.todo($got eq $expected, $description, $todo)
            || $Test.diag("FAILED : $description");
     }
     else {
        $Test.ok($got eq $expected, $description)
            || $Test.diag("FAILED : $description");        
     }
  }

  # then using our test module the test file themselves ...

  use My::Test::Module;

  plan('no_plan');
  # or
  plan :tests<20>;

  ok(2 == 2, '... 2 is equal to 2');
  is(2 + 2, 5, '... 2 plus 2 should be 5', :todo<bug>);

=head1 DESCRIPTION

This is a Perl 6 port of the Perl 5 module Test::Builder.

=head1 PUBLIC ATTRIBUTES

=over 4

=item B<Test::Builder::Output $.output>

=item B<Test::Builder::TestPlan $.testplan>

=back

=head1 METHODS

=over 4

=item B<new( *@args )>

This method actually returns a Test::Builder singleton, creating it if
necessary.  The optional named arguments are:

=over 4

=item C<output>

A Test::Builder::Output object.

=item C<plan>

A Test::Builder::TestPlan object.

=back

=item B<create( *@args )>

This method actually creates and returns a new Test::Builder instance.  It
takes the same optional named arguments as C<new>.

=item B<plan( Str $explanation?, Int $tests? )>

Sets the current test plan or throws an exception if there's already a plan in
place.  You have two options for the plan.  If you pass a pair such as C<tests
=Egt 10>, the plan is to run ten tests.  If you pass the string C<no_plan>,
there is no set number of tests to run.

Those are the only valid arguments.

You must have a plan set before you can record any tests.

=item B<ok returns Bit ( Bit $passed, Str $description = '' )>

Records that a test has passed or failed, depending on the value of C<$passed>,
recording C<$description> as an optional explanation.

=item B<todo returns Bit ( Bit $passed, Str $description?, Str $reason? )>

Records that a test has passed or failed, depending on C<$passed> with an
optional C<$description>, but marks it as a TODO test with an optional
C<$reason>.

=item B<skip( Int $num = 1, Str $reason = 'skipped' )>

Records the skipping of C<$num> tests (one by default), giving an optional
C<$reason> for skipping them.

=item B<skip_all()>

Skips all of the tests before running them.

Fails if there is a test plan set.

=item B<BAILOUT( Str $reason = '' )>

Aborts the entire test run.

=item B<get_test_number()>

Returns the number of the I<next> test to record.

=item B<report_test( Test::Builder::Test $test )>

Records a test.  Internal use only, probably.

=back

=head1 SEE ALSO

Perl 5 Test::Builder.

=head1 AUTHORS

Perl6::MetaModel 2.0 code by Stevan Little E<lt>stevan@iinteractive.comE<gt>

Perl 6 code by chromatic E<lt>chromatic@wgz.orgE<gt>

documentation by Stevan Little E<lt>stevan@iinteractive.comE<gt> and chromatic.

=head1 Perl 6 Code

  class Test::Builder-0.2.1;
  
  use Test::Builder::Test;
  use Test::Builder::Output;
  use Test::Builder::TestPlan;
  
  my  Test::Builder           $:singleton;
  has Test::Builder::Output   $.output handles 'diag';
  has Test::Builder::TestPlan $.testplan;
  has                         @:results;
  
  method new ( Test::Builder $Class: $plan?, $output? )
  {
      return $:singleton //= $Class.SUPER::new(
          testplan => $plan, output => $output
      );
  }
  
  method create ( Test::Builder $Class: $plan?, $output? )
  {
      return $Class.new( testplan => $plan, output => $output );
  }
  
  submethod BUILD
  (
      Test::Builder::TestPlan $.testplan?,
      Test::Builder::Output   $.output = Test::Builder::Output.new()
  )
  {}
  
  submethod DESTROY
  {
      my $footer = $.testplan.footer( +@:results );
      $.output.write( $footer ) if $footer;
  }
  
  method get_test_number
  {
      return +@:results + 1;
  }
  
  method plan ( Str $explanation?, Int $tests? )
  {
      fail "Plan already set!" if $.testplan;
  
      if $tests
      {
          $.testplan = Test::Builder::TestPlan.new( expect => $tests );
      }
      elsif $explanation eq 'no_plan'
      {
          $.testplan = Test::Builder::NullPlan.new();
      }
      else
      {
          fail "Unknown plan";
      }
  
      $.output.write( $.testplan.header() );
  }
  
  method ok returns Bit ( $self: Bit $passed, Str $description = '' )
  {
      $self.report_test(
          Test::Builder::Test.new(
              number      => $self.get_test_number(),
              passed      =>  $passed,
              description =>  $description,
          )
      );
  
      return $passed;
  }
  
  method diag ( Str $diagnostic = '' )
  {
      $.output.diag( $diagnostic );
  }
  
  method todo returns Bit ( $self: Bit $passed, Str $description?, Str $reason? )
  {
      $self.report_test(
          Test::Builder::Test.new(
              todo        => 1,
              number      => $self.get_test_number(),
              reason      =>  $reason,
              description =>  $description,
          )
      );
  
      return $passed;
  }
  
  method skip ( $self: Int $num = 1, Str $reason = 'skipped' )
  {
      for 1 .. $num
      {
          $self.report_test(
              Test::Builder::Test.new(
                  skip   => 1,
                  number => $self.get_test_number(),
                  reason =>  $reason,
              )
          );
      }
  }
  
  method skip_all
  {
      fail "Cannot skip_all with a plan" if $.testplan;
  
      $.output.write( "1..0" );
      exit 0;
  }
  
  method BAILOUT ( Str $reason = '' )
  {
      $.output.write( "Bail out!  $reason" );
      exit 255;
  }
  
  method report_test ( Test::Builder::Test $test )
  {
      fail 'No plan set!' unless $.testplan;
  
      push $.results, $test;
      $.output.write( $test.report() );
  }

=cut