1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
#!perl -I..
# Readonly hash tests
use strict;
use Test::More tests => 20;
# Find the module (1 test)
BEGIN {use_ok('Readonly'); }
sub expected
{
my $line = shift;
$@ =~ s/\.$//; # difference between croak and die
return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n";
}
use vars qw/%h1/;
my (%mh1, %mh2);
# creation (3 tests)
eval {Readonly::Hash %h1 => (a=>"A", b=>"B", c=>"C", d=>"D")};
is $@ => '', 'Create global hash';
eval {Readonly::Hash %mh1 => (one=>1, two=>2, three=>3, 4)};
like $@ => qr/odd number of values/, "Odd number of values";
eval {Readonly::Hash %mh1 => {one=>1, two=>2, three=>3, four=>4}};
is $@ => '', 'Create lexical hash';
# fetch (3 tests)
is $h1{a} => 'A', 'Fetch global';
ok !defined $h1{'q'}, 'Nonexistent element undefined';
is $mh1{two} => 2, 'Fetch lexical';
# store (1 test)
eval {$h1{a} = 'Z'};
is $@ => expected(__LINE__-1), 'Store';
# delete (1 test)
eval {delete $h1{c}};
is $@ => expected(__LINE__-1), 'Delete';
# clear (1 test)
eval {%h1 = ()};
is $@ => expected(__LINE__-1), 'Clear';
# exists (3 tests)
ok exists $h1{a}, 'Exists';
eval {ok !exists $h1{x}, "Doesn't exist"};
is $@ => '', "Doesn't exist (no error)";
# keys, values (4 tests)
my @a = sort keys %h1;
is $a[0], 'a', 'Keys a';
is $a[1], 'b', 'Keys b';
@a = sort values %h1;
is $a[0], 'A', 'Values A';
is $a[1], 'B', 'Values B';
# each (2 tests)
my ($k,$v);
while ( ($k,$v) = each %h1)
{
$mh2{$k} = $v;
}
is $mh2{c} => 'C', 'Each C';
is $mh2{d} => 'D', 'Each D';
# untie (1 test)
SKIP: {
skip "Can't catch untie until Perl 5.6", 1 if $] < 5.006;
eval {untie %h1};
is $@ => expected(__LINE__-1), 'Untie';
}
|
