]> git.vpit.fr Git - perl/modules/autovivification.git/blob - t/44-multideref.t
Make multideref work with stores
[perl/modules/autovivification.git] / t / 44-multideref.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use lib 't/lib';
7 use Test::Leaner tests => 3 * 4 * (8 ** 3) * 2;
8
9 my $depth = 3;
10
11 my @prefixes = (
12  '',
13  'exists ',
14  'delete ',
15 );
16
17 my  (@vlex, %vlex, $vrlex);
18 our (@vgbl, %vgbl, $vrgbl);
19
20 my @heads = (
21  '$vlex',    # lexical array/hash
22  '$vgbl',    # global array/hash
23  '$vrlex->', # lexical array/hash reference
24  '$vrgbl->', # global array/hash reference
25 );
26
27 my  $lex;
28 our $gbl;
29
30 my @derefs = (
31  '[0]',      # array const (aelemfast)
32  '[$lex]',   # array lexical
33  '[$gbl]',   # array global
34  '[$lex+1]', # array complex
35  '{foo}',    # hash const
36  '{$lex}',   # hash lexical
37  '{$gbl}',   # hash global
38  '{"x$lex"}' # hash complex
39 );
40
41 sub reset_vars {
42  (@vlex, %vlex, $vrlex) = ();
43  (@vgbl, %vgbl, $vrgbl) = ();
44  $lex = 1;
45  $gbl = 2;
46 }
47
48 {
49  package autovivification::TestIterator;
50
51  sub new {
52   my $class = shift;
53
54   my $len = @_;
55   bless {
56    len => $len,
57    max => \@_,
58    idx => [ (0) x $len ],
59   }, $class;
60  }
61
62  sub next {
63   my $self = shift;
64
65   my ($len, $max, $idx) = @$self{qw<len max idx>};
66
67   my $i;
68   ++$idx->[0];
69   for ($i = 0; $i < $len; ++$i) {
70    if ($idx->[$i] == $max->[$i]) {
71     $idx->[$i] = 0;
72     ++$idx->[$i + 1] unless $i == $len - 1;
73    } else {
74     last;
75    }
76   }
77
78   return $i < $len;
79  }
80
81  sub pick {
82   my $self = shift;
83
84   my ($len, $idx) = @$self{qw<len idx>};
85
86   return map $_[$_]->[$idx->[$_]], 0 .. ($len - 1);
87  }
88 }
89
90 my $iterator = autovivification::TestIterator->new(3, 4, (8) x $depth);
91 do {
92  my @elems = $iterator->pick(\@prefixes, \@heads, (\@derefs) x $depth);
93  my $code  = join '', @elems;
94  my $exp   = $elems[0] eq 'exists ' ? !1 : undef;
95  reset_vars();
96  my ($res, $err) = do {
97   local $SIG{__WARN__} = sub { die @_ };
98   local $@;
99   my $r = eval <<" CODE";
100   no autovivification;
101   $code
102  CODE
103   ($r, $@)
104  };
105  is $err, '',   "$code: no exception";
106  is $res, $exp, "$code: value";
107 } while ($iterator->next);