Test multideref support

diff --git a/MANIFEST b/MANIFEST
index dba48fcd2bee89aca73010c6920ff8805d9b6e68..5e68ea771bff4989742533b603ad334224bb0e8d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -23,6 +23,7 @@ t/40-scope.t
 t/41-padsv.t
 t/42-deparse.t
 t/43-peep.t
+t/44-multideref.t
 t/50-threads.t
 t/51-threads-teardown.t
 t/lib/Test/Leaner.pm

diff --git a/t/44-multideref.t b/t/44-multideref.t
new file mode 100644 (file)
index 0000000..954b069
--- /dev/null
+++ b/t/44-multideref.t
@@ -0,0 +1,107 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use lib 't/lib';
+use Test::Leaner tests => 3 * 4 * (8 ** 3) * 2;
+
+my $depth = 3;
+
+my @prefixes = (
+ '',
+ 'exists ',
+ 'delete ',
+);
+
+my  (@vlex, %vlex, $vrlex);
+our (@vgbl, %vgbl, $vrgbl);
+
+my @heads = (
+ '$vlex',    # lexical array/hash
+ '$vgbl',    # global array/hash
+ '$vrlex->', # lexical array/hash reference
+ '$vrgbl->', # global array/hash reference
+);
+
+my  $lex;
+our $gbl;
+
+my @derefs = (
+ '[0]',      # array const (aelemfast)
+ '[$lex]',   # array lexical
+ '[$gbl]',   # array global
+ '[$lex+1]', # array complex
+ '{foo}',    # hash const
+ '{$lex}',   # hash lexical
+ '{$gbl}',   # hash global
+ '{"x$lex"}' # hash complex
+);
+
+sub reset_vars {
+ (@vlex, %vlex, $vrlex) = ();
+ (@vgbl, %vgbl, $vrgbl) = ();
+ $lex = 1;
+ $gbl = 2;
+}
+
+{
+ package autovivification::TestIterator;
+
+ sub new {
+  my $class = shift;
+
+  my $len = @_;
+  bless {
+   len => $len,
+   max => \@_,
+   idx => [ (0) x $len ],
+  }, $class;
+ }
+
+ sub next {
+  my $self = shift;
+
+  my ($len, $max, $idx) = @$self{qw<len max idx>};
+
+  my $i;
+  ++$idx->[0];
+  for ($i = 0; $i < $len; ++$i) {
+   if ($idx->[$i] == $max->[$i]) {
+    $idx->[$i] = 0;
+    ++$idx->[$i + 1] unless $i == $len - 1;
+   } else {
+    last;
+   }
+  }
+
+  return $i < $len;
+ }
+
+ sub pick {
+  my $self = shift;
+
+  my ($len, $idx) = @$self{qw<len idx>};
+
+  return map $_[$_]->[$idx->[$_]], 0 .. ($len - 1);
+ }
+}
+
+my $iterator = autovivification::TestIterator->new(3, 4, (8) x $depth);
+do {
+ my @elems = $iterator->pick(\@prefixes, \@heads, (\@derefs) x $depth);
+ my $code  = join '', @elems;
+ my $exp   = $elems[0] eq 'exists ' ? !1 : undef;
+ reset_vars();
+ my ($res, $err) = do {
+  local $SIG{__WARN__} = sub { die @_ };
+  local $@;
+  my $r = eval <<" CODE";
+  no autovivification;
+  $code
+ CODE
+  ($r, $@)
+ };
+ is $err, '',   "$code: no exception";
+ is $res, $exp, "$code: value";
+} while ($iterator->next);