view release on metacpan or  search on metacpan

t/hash.t  view on Meta::CPAN

  ok $n, 2,                                               'default_ctor ( 8)';
  ok(evcheck(sub { $x->df2_reset; },'default_ctor( 9)'), 1,
                                                          '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 keys %n, 1,                                          'default_ctor (19)';
  ok ref($n{2}), 'Y',                                     'default_ctor (20)';
  ok $n{2}->value, 3,                                     'default_ctor (21)';
}

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

=head2 Tests 296--320: forward

=cut

{
  my ($n, @n, %n);
  ok(evcheck(sub { package X;
                   Class::MethodMaker->import([hash =>
                                                 [{ -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(a=>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(b=>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, 2,                                                    'forward (13)';
  ok $n[1], undef,                                             'forward (14)';
  ok(evcheck(sub { $x->st1_set(script=>stat(catfile($Bin,$Script)),
                               bin   =>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)');
  print STDERR Data::Dumper->Dump([\%n],[qw(n)])
    if $ENV{TEST_DEBUG};

  ok keys %n, 3,                                               'forward (17)';
  ok S_ISREG($n{script}), 1,                                   'forward (18)';
  ok S_ISDIR($n{bin}), 1,                                      'forward (19)';
  ok exists $n{b};                                            # forward (20)
  ok ! defined $n{b};                                         # forward (21)

  ok(evcheck(sub { $n = $x->size; }, 'forward (22)'), 1,       'forward (22)');
  ok ref $n, 'HASH',                                           'forward (23)';
  ok keys %$n, 3,                                              'forward (24)';
  {
    sysopen my $fh, catfile($Bin,$Script), O_RDONLY;
    local $/ = undef;
    my $text = <$fh>;
    close $fh;
    ok $n->{script}, length($text),                            'forward (25)';
  }
}

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

=head2 Tests 321--323: 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(script => 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 324--364: manipulate

=cut

{
  my ($n, @n, %n, @p);
  ok(evcheck(sub {$x->a(a=>11,b=>12,c=>13); },  'manipulate ( 1)'),1,
                                                            'manipulate ( 1)');

  ok(evcheck(sub { @n = sort $x->a_keys },  'manipulate ( 2)'), 1,
                                                            'manipulate ( 2)');
  ok @n, 3,                                                 'manipulate ( 3)';
  ok $n[0], 'a',                                            'manipulate ( 4)';
  ok $n[1], 'b',                                            'manipulate ( 5)';