t/op/avhv.t

   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";}