ext/Tie-Hash-NamedCapture/t/tiehash.t

   1 #!./perl -w
   2 use strict;
   3
   4 use Test::More;
   5
   6 # this would break the hash magic setup [perl #134193]
   7 my ($ca, $c) = ( \@{^CAPTURE_ALL}, \@{^CAPTURE} );
   8
   9 my %hashes = (
  10     '+' => \%+,
  11     '-' => \%-,
  12     '{^CAPTURE}' => \%{^CAPTURE},
  13     '{^CAPTURE_ALL}' => \%{^CAPTURE_ALL},
  14 );
  15
  16 foreach (['plus1'],
  17          ['minus1', all => 1],
  18          ['plus2', all => 0],
  19          ['plus3', zlonk => 1],
  20          ['minus2', thwapp => 0, all => 1],
  21         ) {
  22     my $name = shift @$_;
  23     my $hash = $hashes{$name} = {};
  24     isa_ok(tie(%$hash, 'Tie::Hash::NamedCapture', @$_),
  25            'Tie::Hash::NamedCapture', "%$name");
  26 }
  27
  28 is("abcdef" =~ /(?<foo>[ab])*(?<bar>c)(?<foo>d)(?<bar>[ef]*)/, 1,
  29    "We matched");
  30
  31 foreach my $name (qw(+ {^CAPTURE} plus1 plus2 plus3)) {
  32     my $hash = $hashes{$name};
  33     is_deeply($hash, { foo => 'b', bar => 'c' }, "%$name is as expected");
  34 }
  35
  36 foreach my $name (qw(- {^CAPTURE_ALL} minus1 minus2)) {
  37     my $hash = $hashes{$name};
  38     is_deeply($hash, { foo => [qw(b d)], bar => [qw(c ef)] },
  39               "%$name is as expected");
  40 }
  41
  42 done_testing();