The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! /usr/bin/perl
#---------------------------------------------------------------------
# 10-CPHash.t
# Copyright 1997 Christopher J. Madsen
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
# GNU General Public License or the Artistic License for more details.
#
# Test the Tie::CPHash module
#---------------------------------------------------------------------

use 5.006;
use strict;
use warnings;

use Test::More 0.88 tests => 23; # done_testing

use Tie::CPHash;

my(%h,$j,$test);

tie(%h, 'Tie::CPHash');
ok(1, 'tied %h');

isa_ok(tied(%h), 'Tie::CPHash');

is($h{Hello}, undef, "Hello not yet defined");

ok(!exists($h{Hello}), "Hello does not exist");

SKIP: {
  skip 'SCALAR added in Perl 5.8.3', 1 unless $] >= 5.008003;
  ok((not scalar %h), 'SCALAR empty');
};

$h{Hello} = 'World';
$j = $h{HeLLo};
is(           $j => 'World',  'HeLLo - World');
is_deeply([keys %h] => ['Hello'],  'last key Hello');

ok(exists($h{Hello}), "Hello now exists");

$h{World} = 'HW';
$h{HELLO} = $h{World};
is(tied(%h)->key('hello') => 'HELLO',  'last key HELLO');

SKIP: {
  skip 'SCALAR added in Perl 5.8.3', 1 unless $] >= 5.008003;
  ok(scalar %h, 'SCALAR not empty');
};

is(delete $h{Hello}, 'HW',  "deleted Hello");
is(delete $h{Hello}, undef, "can't delete Hello twice");

SKIP: {
  skip 'SCALAR added in Perl 5.8.3', 1 unless $] >= 5.008003;
  ok(scalar %h, 'SCALAR still not empty');
};

is(tied(%h)->key('hello') => undef,  'hello not in keys');

tied(%h)->add(qw(HeLlO world));

is($h{world}, 'HW', 'World still exists');
is($h{hello}, 'world', 'hello was pushed');

is(tied(%h)->key('hello') => 'HeLlO',  'hello is HeLlO');
is(tied(%h)->key('world') => 'World',  'world is World');

%h = ();

SKIP: {
  skip 'SCALAR added in Perl 5.8.3', 1 unless $] >= 5.008003;
  ok(!scalar %h, 'SCALAR now empty');
};

{
  my %i;

  tie( %i, 'Tie::CPHash', Hello => 'World');
  is( $i{hello}, 'World', 'initialized from list' );
  is( tied(%i)->key('hello'), 'Hello', 'list remembers case' );
}

{
  tie( my %i, 'Tie::CPHash', qw(Hello World  hello world));

  is( $i{Hello}, 'world', '1 line initialized from list');
  is( tied(%i)->key('Hello'), 'hello', '1 line remembers case');
}

done_testing;

# Local Variables:
# mode: perl
# End: