view release on metacpan or  search on metacpan

t/array.t  view on Meta::CPAN

                                                          'default_ctor ( 9)');
  ok(evcheck(sub { $n = $x->df2_isset; }, 'default_ctor(10)'), 1,
                                                          'default_ctor (10)');
  ok $n;                                                 # default_ctor (11)
  ok(evcheck(sub { $n = $x->df2_index(2)->value; }, 'default_ctor(12)'), 1,
                                                          'default_ctor (12)');
  ok $n, 3,                                               'default_ctor (13)';
  ok(evcheck(sub { $n = $x->df3_isset; }, 'default_ctor(14)'), 1,
                                                          'default_ctor (14)');
  ok $n;                                                 # default_ctor (15)
  ok(evcheck(sub { $n = $x->df3_index(2)->value; }, 'default_ctor(16)'), 1,
                                                          'default_ctor (16)');
  ok $n, -3,                                              'default_ctor (17)';

  ok evcheck(sub { @n = $x->df2 }, 'default_ctor (18)'),1,'default_ctor (18)';
  ok @n, 3,                                               'default_ctor (19)';
  ok ref($n[2]), 'Y',                                     'default_ctor (20)';
  ok $n[2]->value, 3,                                     'default_ctor (21)';
  ok ref($n[0]), 'Y',                                     'default_ctor (22)';
  ok ref($n[1]), 'Y',                                     'default_ctor (23)';
}

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

=head2 Tests 272--293: forward

=cut

{
  my ($n, @n);
  ok(evcheck(sub { package X;
                   Class::MethodMaker->import([array =>
                                                 [{ -type => 'File::stat',
                                                    -forward => [qw/ mode
                                                                     size /],
                                                  },
                                                  qw( st1 ),
                                                  # Keeping the second call
                                                  # here ensures that we check
                                                  # that mode, size are
                                                  # forwarded to st1
                                                  { -type => 'IO::Handle',
                                                    -forward => 'read', },
                                                  qw( st2 ),
                                                 ]])},
             'forward ( 1)'),
     1,                                                        'forward ( 1)');
  ok(evcheck(sub { $n = $x->st1_isset; }, 'forward ( 2)'), 1,  'forward ( 2)');
  ok ! $n;                                                    # forward ( 3)
  ok(evcheck(sub { $x->st1(4); }, 'forward ( 4)'), 0,          'forward ( 4)');
  ok(evcheck(sub { @n = $x->st1; }, 'forward ( 5)'), 1,        'forward ( 5)');
  ok @n, 0,                                                    'forward ( 6)';
  ok(evcheck(sub { $n = $x->st1_isset; }, 'forward ( 7)'), 1,  'forward ( 7)');
  ok ! $n;                                                    # forward ( 8)
  ok(evcheck(sub { $x->st1(undef); }, 'forward ( 9)'), 1,      'forward ( 9)');
  ok(evcheck(sub { $n = $x->st1_isset; }, 'forward (10)'), 1,  'forward (10)');
  ok $n;                                                      # forward (11)
  ok(evcheck(sub { @n = $x->st1; }, 'forward (12)'), 1,        'forward (12)');
  ok @n, 1,                                                    'forward (13)';
  ok $n[0], undef,                                             'forward (14)';
  ok(evcheck(sub { $x->st1(stat(catfile($Bin,$Script)),
                           stat(catfile($Bin))) }, 'forward (15)'),
     1,                                                        'forward (15)');
  print STDERR Data::Dumper->Dump([$x],[qw(x)])
    if $ENV{TEST_DEBUG};
  print STDERR B::Deparse->new('-p', '-sC')->coderef2text(\&X::mode), "\n"
    if $ENV{TEST_DEBUG};
  ok(evcheck(sub { @n = $x->mode; }, 'forward (16)'), 1,       'forward (16)');

  ok @n, 2,                                                    'forward (17)';
  ok S_ISREG($n[0]), 1,                                        'forward (18)';
  ok S_ISDIR($n[1]), 1,                                        'forward (19)';

  ok(evcheck(sub { $n = $x->size; }, 'forward (20)'), 1,       'forward (20)');
  ok @$n, 2,                                                   'forward (21)';
  {
    sysopen my $fh, catfile($Bin,$Script), O_RDONLY;
    local $/ = undef;
    my $text = <$fh>;
    close $fh;
    ok $n->[0], length($text),                                 'forward (22)';
  }
}

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

=head2 Tests 294--296: forward_args

=cut

{
  my $n;
  # Instantiate st2 as IO::File, which is a subclass of IO::Handle.  This
  # should be fine
  ok(evcheck(sub { $x->st2(IO::File->new(catfile($Bin,$Script))) },
             'forward_args ( 1)'), 1,                     'forward_args ( 1)');
  ok(evcheck(sub { $x->read($n, 30); }, 'forward_args ( 2)'), 1,
                                                          'forward_args ( 2)');
  ok $n, '# (X)Emacs mode: -*- cperl -*-',                'forward_args ( 3)';
}



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

=head2 Tests 297--349: manipulate

=cut

{
  my ($n, @n);

  Y::reset;

  ok evcheck(sub { $x->df2_reset; }, 'manipulate ( 1)'), 1, 'manipulate ( 1)';

  # _push
  ok evcheck(sub { $x->df2_push(Y->new, Y->new); }, 'manipulate ( 2)'), 1,
                                                            'manipulate ( 2)';
  ok evcheck(sub { @n = $x->df2; }, 'manipulate ( 3)'), 1,  'manipulate ( 3)';
  ok @n, 2,                                                 'manipulate ( 4)';
  ok $n[0]->value, 1,                                       'manipulate ( 5)';