Commit | Line | Data |
5d5aaa5e |
1 | #!./perl |
2 | |
3 | package Tie::StdArray; |
4 | sub TIEARRAY { bless [], $_[0] } |
5 | sub STORE { $_[0]->[$_[1]] = $_[2] } |
6 | sub FETCH { $_[0]->[$_[1]] } |
7 | |
8 | package main; |
9 | |
10 | print "1..4\n"; |
11 | |
12 | $sch = { |
13 | 'abc' => 1, |
14 | 'def' => 2, |
15 | 'jkl' => 3, |
16 | }; |
17 | |
18 | # basic normal array |
19 | $a = []; |
20 | $a->[0] = $sch; |
21 | |
22 | $a->{'abc'} = 'ABC'; |
23 | $a->{'def'} = 'DEF'; |
24 | $a->{'jkl'} = 'JKL'; |
25 | $a->{'a'} = 'A'; #should extend schema |
26 | |
27 | @keys = keys %$a; |
28 | @values = values %$a; |
29 | |
30 | if ($#keys == 3 && $#values == 3) {print "ok 1\n";} else {print "not ok 1\n";} |
31 | |
32 | $i = 0; # stop -w complaints |
33 | |
34 | while (($key,$value) = each %$a) { |
35 | if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { |
36 | $key =~ y/a-z/A-Z/; |
37 | $i++ if $key eq $value; |
38 | } |
39 | } |
40 | |
41 | if ($i == 4) {print "ok 2\n";} else {print "not ok 2\n";} |
42 | |
43 | # quick check with tied array |
44 | tie @fake, 'Tie::StdArray'; |
45 | $a = \@fake; |
46 | $a->[0] = $sch; |
47 | |
48 | $a->{'abc'} = 'ABC'; |
49 | if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";} |
50 | |
51 | # quick check with tied array & tied hash |
52 | @INC = ("./lib", "../lib"); |
53 | require Tie::Hash; |
54 | tie %fake, Tie::StdHash; |
55 | %fake = %$sch; |
56 | $a->[0] = \%fake; |
57 | |
58 | $a->{'abc'} = 'ABC'; |
59 | if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";} |