Skip to content

Commit

Permalink
move to new Struct::Path format for hash regs
Browse files Browse the repository at this point in the history
  • Loading branch information
@mr-mixas
mr-mixas committed Dec 15, 2018
1 parent 11c3bd5 commit 8424ec6
Show file tree
Hide file tree
Showing 3 changed files with 35 additions and 47 deletions.
46 changes: 20 additions & 26 deletions lib/Struct/Path/PerlStyle.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -212,7 +212,7 @@ sub _push_hash {
push @{$step{K}}, $body;
} elsif ($delim eq '/' and !$type or $type eq 'm') {
$mods = join('', sort(split('', $mods)));
eval { push @{$step{R}}, $QR_MAP->{$mods}->($body) };
eval { push @{$step{K}}, $QR_MAP->{$mods}->($body) };
if ($@) {
(my $err = $@) =~ s/ at .+//s;
croak "Step #" . scalar @{$steps} . " $err";
Expand Down Expand Up @@ -369,44 +369,38 @@ sub path2str($) {

$out .= "[" . join(",", @{items}) . "]";
} elsif (ref $step eq 'HASH') {
my $types = [ grep { exists $step->{$_} } qw(K R) ];
if (keys %{$step} != @{$types}) {
$types = { map { $_, 1 } @{$types} };
my @errs = grep { !exists $types->{$_} } sort keys %{$step};
croak "Unsupported hash definition (" .
join(',', @errs) . "), step #$sc"
}
my $keys;

if (exists $step->{K}) {
croak "Unsupported hash keys definition, step #$sc"
unless (ref $step->{K} eq 'ARRAY');
croak "Unsupported hash definition (extra keys), step #$sc"
if (keys %{$step} > 1);
$keys = $step->{K};

for my $k (@{$step->{K}}) {
croak "Unsupported hash key type 'undef', step #$sc"
unless (defined $k);
croak "Unsupported hash key type '@{[ref $k]}', step #$sc"
if (ref $k);
} elsif (keys %{$step}) {
croak "Unsupported hash definition (unknown keys), step #$sc";
} else {
$keys = [];
}

for my $k (@{$keys}) {
if (is_regexp($k)) {
my ($patt, $mods) = regexp_pattern($k);
$mods =~ s/[dlu]//g; # for Perl's internal use (c) perlre
push @items, "/$patt/$mods";

} elsif (defined $k and ref $k eq '') {
push @items, $k;

unless ($k =~ /^$HASH_KEY_CHARS+$/) {
$items[-1] =~ s/([\Q$ESCP\E])/$ESCP{$1}/gs; # escape
$items[-1] = qq("$items[-1]"); # quote
}
}
}

if (exists $step->{R}) {
croak "Unsupported hash regexps definition, step #$sc"
unless (ref $step->{R} eq 'ARRAY');

for my $r (@{$step->{R}}) {
croak "Regexp expected for regexps item, step #$sc"
unless (is_regexp($r));

my ($patt, $mods) = regexp_pattern($r);
$mods =~ s/[dlu]//g; # for Perl's internal use (c) perlre
push @items, "/$patt/$mods";
} else {
croak "Unsupported hash key type '" .
(ref($k) || 'undef') . "', step #$sc"
}
}

Expand Down
4 changes: 2 additions & 2 deletions t/hashes-keys.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,13 +11,13 @@ use lib 't';
use _common qw(roundtrip t_dump);

eval { path2str([{garbage => ['a']}]) };
like($@, qr/^Unsupported hash definition \(garbage\), step #0 /);
like($@, qr/^Unsupported hash definition \(unknown keys\), step #0 /);

eval { path2str([{K => 'a'}]) };
like($@, qr/^Unsupported hash keys definition, step #0 /);

eval { path2str([{K => ['a'], garbage => ['b']}]) };
like($@, qr/^Unsupported hash definition \(garbage\), step #0 /);
like($@, qr/^Unsupported hash definition \(extra keys\), step #0 /);

eval { path2str([{K => [undef]}]) };
like($@, qr/^Unsupported hash key type 'undef', step #0 /);
Expand Down
32 changes: 13 additions & 19 deletions t/hashes-regs.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
use strict;
use warnings FATAL => 'all';

use Test::More tests => 24;
use Test::More tests => 22;
use Struct::Path::PerlStyle qw(str2path path2str);

use lib 't';
Expand Down Expand Up @@ -47,74 +47,68 @@ SKIP: {
like($@, qr|^Step #0 Eval-group not allowed |);
}

eval { path2str([{R => 1}]) };
like($@, qr/^Unsupported hash regexps definition, step #0 /);

eval { path2str([{R => [1]}]) };
like($@, qr/^Regexp expected for regexps item, step #0 /);

roundtrip (
[{R => [qr/pat/,qr/pat/i,qr/pat/m,qr/pat/s,qr/pat/x]}],
[{K => [qr/pat/,qr/pat/i,qr/pat/m,qr/pat/s,qr/pat/x]}],
'{/pat/,/pat/i,/pat/m,/pat/s,/pat/x}',
'//'
);

is_deeply(
str2path('{m/pat/,m!pat!i,m|pat|m,m#pat#s,m{pat}x,m(pat)i,m[pat]i,m<pat>i,m"pat"i,m\'pat\'i}'),
[{R => [qr/pat/,qr/pat/i,qr/pat/m,qr/pat/s,qr/pat/x,qr/pat/i,qr/pat/i,qr/pat/i,qr/pat/i,qr/pat/i]}],
[{K => [qr/pat/,qr/pat/i,qr/pat/m,qr/pat/s,qr/pat/x,qr/pat/i,qr/pat/i,qr/pat/i,qr/pat/i,qr/pat/i]}],
"m//"
);

roundtrip (
[{R => [qr/^Lonesome regexp$/mi]}],
[{K => [qr/^Lonesome regexp$/mi]}],
'{/^Lonesome regexp$/mi}',
'Lonesome regexp'
);

roundtrip (
[{K => ['Mixed', 'with'], R => [qr/regular keys/]}],
'{Mixed,with,/regular keys/}',
[{K => ['Mixed', 'with', qr/regular/, 'keys']}],
'{Mixed,with,/regular/,keys}',
'Regexps mixed with keys'
);

roundtrip (
[{R => [qr//,qr//msix]}],
[{K => [qr//,qr//msix]}],
'{//,//msix}',
'Empty pattern'
);

roundtrip (
[{R => [qr|^Regular\/\/Slashes|]}],
[{K => [qr|^Regular\/\/Slashes|]}],
'{/^Regular\/\/Slashes/}',
'Regular slashes'
);

roundtrip (
[{R => [qr/^TwoBack\\Slashes/]}],
[{K => [qr/^TwoBack\\Slashes/]}],
'{/^TwoBack\\\\Slashes/}',
'Back slashes'
);

roundtrip (
[{R => [qr/Character\b\B\d\D\s\S\w\WClasses/]}],
[{K => [qr/Character\b\B\d\D\s\S\w\WClasses/]}],
'{/Character\b\B\d\D\s\S\w\WClasses/}',
'Character classes'
);

roundtrip (
[{R => [qr/Escape\t\n\r\f\b\a\eSequences/]}],
[{K => [qr/Escape\t\n\r\f\b\a\eSequences/]}],
'{/Escape\t\n\r\f\b\a\eSequences/}',
'Escape sequences'
);

roundtrip (
[{R => [qr/Escape\x{263A}|\x1b|\N{U+263D}|\c[|\033Sequences2/]}],
[{K => [qr/Escape\x{263A}|\x1b|\N{U+263D}|\c[|\033Sequences2/]}],
'{/Escape\x{263A}|\x1b|\N{U+263D}|\c[|\033Sequences2/}',
'Escape sequences2'
);

roundtrip (
[{R => [qr#^([^\?]{1,5}|.+|\\?|)*$#]}],
[{K => [qr#^([^\?]{1,5}|.+|\\?|)*$#]}],
'{/^([^\?]{1,5}|.+|\\\\?|)*$/}',
'Metacharacters'
);
Expand Down

0 comments on commit 8424ec6

Please sign in to comment.