t/op/avhv.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 require Tie::Array;
   9
  10 package Tie::BasicArray;
  11 @ISA = 'Tie::Array';
  12 sub TIEARRAY  { bless [], $_[0] }
  13 sub STORE     { $_[0]->[$_[1]] = $_[2] }
  14 sub FETCH     { $_[0]->[$_[1]] }
  15 sub FETCHSIZE { scalar(@{$_[0]})}
  16 sub STORESIZE { $#{$_[0]} = $_[1]+1 }
  17
  18 package main;
  19
  20 print "1..6\n";
  21
  22 $sch = {
  23     'abc' => 1,
  24     'def' => 2,
  25     'jkl' => 3,
  26 };
  27
  28 # basic normal array
  29 $a = [];
  30 $a->[0] = $sch;
  31
  32 $a->{'abc'} = 'ABC';
  33 $a->{'def'} = 'DEF';
  34 $a->{'jkl'} = 'JKL';
  35 $a->{'a'} = 'A';     #should extend schema
  36
  37 @keys = keys %$a;
  38 @values = values %$a;
  39
  40 if ($#keys == 3 && $#values == 3) {print "ok 1\n";} else {print "not ok 1\n";}
  41
  42 $i = 0;         # stop -w complaints
  43
  44 while (($key,$value) = each %$a) {
  45     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
  46         $key =~ y/a-z/A-Z/;
  47         $i++ if $key eq $value;
  48     }
  49 }
  50
  51 if ($i == 4) {print "ok 2\n";} else {print "not ok 2\n";}
  52
  53 # quick check with tied array
  54 tie @fake, 'Tie::StdArray';
  55 $a = \@fake;
  56 $a->[0] = $sch;
  57
  58 $a->{'abc'} = 'ABC';
  59 if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
  60
  61 # quick check with tied array
  62 tie @fake, 'Tie::BasicArray';
  63 $a = \@fake;
  64 $a->[0] = $sch;
  65
  66 $a->{'abc'} = 'ABC';
  67 if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
  68
  69 # quick check with tied array & tied hash
  70 require Tie::Hash;
  71 tie %fake, Tie::StdHash;
  72 %fake = %$sch;
  73 $a->[0] = \%fake;
  74
  75 $a->{'abc'} = 'ABC';
  76 if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
  77
  78 # hash slice
  79 my $slice = join('', 'x',@$a{'abc','def'},'x');
  80 print "not " if $slice ne 'xABCx';
  81 print "ok 6\n";