]> git.vpit.fr Git - perl/modules/autovivification.git/blob - t/44-multideref.t
Update VPIT::TestHelpers to 15e8aee3
[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 => 4 * 4 * (8 ** 3) * 2;
8
9 my $depth = 3;
10
11 my $magic_val = 123;
12
13 my @prefixes = (
14  sub { $_[0]                },
15  sub { "$_[0] = $magic_val" },
16  sub { "exists $_[0]"       },
17  sub { "delete $_[0]"       },
18 );
19
20 my  (@vlex, %vlex, $vrlex);
21 our (@vgbl, %vgbl, $vrgbl);
22
23 my @heads = (
24  '$vlex',    # lexical array/hash
25  '$vgbl',    # global array/hash
26  '$vrlex->', # lexical array/hash reference
27  '$vrgbl->', # global array/hash reference
28 );
29
30 my  $lex;
31 our $gbl;
32
33 my @derefs = (
34  '[0]',      # array const (aelemfast)
35  '[$lex]',   # array lexical
36  '[$gbl]',   # array global
37  '[$lex+1]', # array complex
38  '{foo}',    # hash const
39  '{$lex}',   # hash lexical
40  '{$gbl}',   # hash global
41  '{"x$lex"}' # hash complex
42 );
43
44 sub reset_vars {
45  (@vlex, %vlex, $vrlex) = ();
46  (@vgbl, %vgbl, $vrgbl) = ();
47  $lex = 1;
48  $gbl = 2;
49 }
50
51 {
52  package autovivification::TestIterator;
53
54  sub new {
55   my $class = shift;
56
57   my (@lists, @max);
58   for my $arg (@_) {
59    next unless defined $arg;
60    my $type = ref $arg;
61    my $list;
62    if ($type eq 'ARRAY') {
63     $list = $arg;
64    } elsif ($type eq '') {
65     $list = [ 1 .. $arg ];
66    } else {
67     die "Invalid argument of type $type";
68    }
69    my $max = @$list;
70    die "Empty list" unless $max;
71    push @lists, $list;
72    push @max,   $max;
73   }
74
75   my $len = @_;
76   bless {
77    len   => $len,
78    max   => \@max,
79    lists => \@lists,
80    idx   => [ (0) x $len ],
81   }, $class;
82  }
83
84  sub next {
85   my $self = shift;
86
87   my ($len, $max, $idx) = @$self{qw<len max idx>};
88
89   my $i;
90   ++$idx->[0];
91   for ($i = 0; $i < $len; ++$i) {
92    if ($idx->[$i] == $max->[$i]) {
93     $idx->[$i] = 0;
94     ++$idx->[$i + 1] unless $i == $len - 1;
95    } else {
96     last;
97    }
98   }
99
100   return $i < $len;
101  }
102
103  sub items {
104   my $self = shift;
105
106   my ($len, $lists, $idx) = @$self{qw<len lists idx>};
107
108   return map $lists->[$_]->[$idx->[$_]], 0 .. ($len - 1);
109  }
110 }
111
112 my $iterator = autovivification::TestIterator->new(
113  \@prefixes, \@heads, (\@derefs) x $depth,
114 );
115 do {
116  my ($prefix, @elems) = $iterator->items;
117  my $code = $prefix->(join '', @elems);
118  my $exp  = ($code =~ /^\s*exists/) ? !1
119                                     : (($code =~ /=\s*$magic_val/) ? $magic_val
120                                                                    : undef);
121  reset_vars();
122  my ($res, $err) = do {
123   local $SIG{__WARN__} = sub { die @_ };
124   local $@;
125   my $r = eval <<" CODE";
126   no autovivification;
127   $code
128  CODE
129   ($r, $@)
130  };
131  is $err, '',   "$code: no exception";
132  is $res, $exp, "$code: value";
133 } while ($iterator->next);