This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
deprecate C<use attrs>
[perl5.git] / t / op / avhv.t
1 #!./perl
2       
3 BEGIN {
4     chdir 't' if -d 't';
5     unshift @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..12\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
36 @keys = keys %$a;
37 @values = values %$a;
38
39 if ($#keys == 2 && $#values == 2) {print "ok 1\n";} else {print "not ok 1\n";}
40
41 $i = 0;         # stop -w complaints
42
43 while (($key,$value) = each %$a) {
44     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
45         $key =~ y/a-z/A-Z/;
46         $i++ if $key eq $value;
47     }
48 }
49
50 if ($i == 3) {print "ok 2\n";} else {print "not ok 2\n";}
51
52 # quick check with tied array
53 tie @fake, 'Tie::StdArray';
54 $a = \@fake;
55 $a->[0] = $sch;
56
57 $a->{'abc'} = 'ABC';
58 if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
59
60 # quick check with tied array
61 tie @fake, 'Tie::BasicArray';
62 $a = \@fake;
63 $a->[0] = $sch;
64
65 $a->{'abc'} = 'ABC';
66 if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
67
68 # quick check with tied array & tied hash
69 require Tie::Hash;
70 tie %fake, Tie::StdHash;
71 %fake = %$sch;
72 $a->[0] = \%fake;
73
74 $a->{'abc'} = 'ABC';
75 if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
76
77 # hash slice
78 my $slice = join('', 'x',@$a{'abc','def'},'x');
79 print "not " if $slice ne 'xABCx';
80 print "ok 6\n";
81
82 # evaluation in scalar context
83 my $avhv = [{}];
84 print "not " if %$avhv;
85 print "ok 7\n";
86
87 push @$avhv, "a";
88 print "not " if %$avhv;
89 print "ok 8\n";
90
91 $avhv = [];
92 eval { $a = %$avhv };
93 print "not " unless $@ and $@ =~ /^Can't coerce array into hash/;
94 print "ok 9\n";
95
96 $avhv = [{foo=>1, bar=>2}];
97 print "not " unless %$avhv =~ m,^\d+/\d+,;
98 print "ok 10\n";
99
100 # check if defelem magic works
101 sub f {
102     print "not " unless $_[0] eq 'a';
103     $_[0] = 'b';
104     print "ok 11\n";
105 }
106 $a = [{key => 1}, 'a'];
107 f($a->{key});
108 print "not " unless $a->[1] eq 'b';
109 print "ok 12\n";
110