The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# (X)Emacs mode: -*- cperl -*-

use strict;

=head1 Unit Test Package for Class::MethodMaker

This package tests the scalar type of Class::MethodMaker

=cut

use FindBin                1.42 qw( $Bin $Script );
use Test                   1.13 qw( ok plan );

use lib $Bin;
use test qw( evcheck );

BEGIN {
  plan tests  => 32,
       todo   => [],
}

# ----------------------------------------------------------------------------

=head2 Test 1: compilation

This test confirms that the test script and the modules it calls compiled
successfully.

=cut

package X;

use Class::MethodMaker
  [ new => 'new',
    new => [qw/ -hash new_hash_init /],
    new => [qw/ -init new_with_init
                -hash new_both /],
  ];

my @args_in_init;
my $foo_called;
my $bar_called;

sub init {
  my ($self, @args) = @_;
  @args_in_init = @args;
}

sub foo {
  my ($self, $new) = @_;
  defined $new and $self->{'foo'} = $new;
  $foo_called = 1;
  $self->{'foo'};
}

sub bar {
  my ($self, $new) = @_;
  defined $new and $self->{'bar'} = $new;
  $bar_called = 1;
  $self->{'bar'};
}

package main;

ok 1, 1, 'compilation';

# -------------------------------------

=head Tests 2--3: new

=cut

{
  my $o;

  ok evcheck(sub { $o = new X; }, 'new ( 1)'), 1,                  'new ( 1)';
  ok ref $o, 'X',                                                  'new ( 2)';
}

# -------------------------------------

=head Tests 4--9: new_with_init

=cut

{
  my $o;
  my @args = (1, 2, 3);
  ok(evcheck(sub { $o = X->new_with_init(@args) }, 'new_with_init ( 1)'), 1,
                                                         'new_with_init ( 1)');
  ok ref $o, 'X',                                        'new_with_init ( 2)';
  ok $#args_in_init, $#args,                             'new_with_init ( 3)';
  ok $args_in_init[$_], $args[$_], sprintf('new_with_init (%2d)', $_+4)
    for 0..$#args;

  @args_in_init = ();
}

# -------------------------------------

=head Tests 10--15: new_hash_init

=cut

{
  my $o;
  ok(evcheck(sub { $o = X->new_hash_init( 'foo' => 123, 'bar' => 456 ) },
           'new_hash_init ( 1)'), 1,                     'new_hash_init ( 1)');
  ok ref $o, 'X',                                        'new_hash_init ( 2)';
  ok $foo_called, 1,                                     'new_hash_init ( 3)';
  ok $bar_called, 1,                                     'new_hash_init ( 4)';
  ok $o->foo, 123,                                       'new_hash_init ( 5)';
  ok $o->bar, 456,                                       'new_hash_init ( 6)';

  $foo_called = 0;
  $bar_called = 0;
}
# -------------------------------------

=head Tests 16--21: new_hash_init (taking hashref)

=cut

{
  my $o;
  $foo_called = 0;
  $bar_called = 0;

  ok(evcheck(sub { $o = X->new_hash_init({ 'foo' => 111, 'bar' => 444 }) },
           'new_hash_init (taking hashref) ( 1)'), 1,
                                        'new_hash_init (taking hashref) ( 1)');
  ok ref $o, 'X',                       'new_hash_init (taking hashref) ( 2)';
  ok $foo_called, 1,                    'new_hash_init (taking hashref) ( 3)';
  ok $bar_called, 1,                    'new_hash_init (taking hashref) ( 4)';
  ok $o->foo, 111,                      'new_hash_init (taking hashref) ( 5)';
  ok $o->bar, 444,                      'new_hash_init (taking hashref) ( 6)';

  $foo_called = 0;
  $bar_called = 0;
}

# -------------------------------------

=head Tests 22--32: new_hash_init (with init)

=cut

{
  my $o;

  my @args = ('foo' => 987, 'bar' => 654);
  ok(evcheck(sub { $o = X->new_both(@args) },
                'new_hash_init (with init) ( 1)'), 1,
                                             'new_hash_init (with init) ( 1)');
  ok ref $o, 'X',                            'new_hash_init (with init) ( 2)';
  ok $foo_called, 1,                         'new_hash_init (with init) ( 3)';
  ok $bar_called, 1,                         'new_hash_init (with init) ( 4)';
  ok $o->foo, 987,                           'new_hash_init (with init) ( 5)';
  ok $o->bar, 654,                           'new_hash_init (with init) ( 6)';
  ok $#args_in_init, $#args,                 'new_hash_init (with init) ( 7)';
  ok($args_in_init[$_], $args[$_],
     sprintf('new_hash_init (with init) (%2d)', $_+8))
    for 0..$#args;

  $foo_called = 0;
  $bar_called = 0;
  @args_in_init = ();
}

# ----------------------------------------------------------------------------