Commit | Line | Data |
a49ce94b |
1 | BEGIN { |
2 | use strict; |
3 | use warnings; |
4 | use Test::More tests=>3; |
5 | } |
6 | |
7 | { |
8 | ## Copied from Moose::Util::TypeConstraints |
9 | use re "eval"; |
10 | |
11 | my $any; |
12 | my $valid_chars = qr{[\w:]}; |
13 | my $type_atom = qr{ $valid_chars+ }; |
14 | |
15 | my $type = qr{ $valid_chars+ (?: \[ (??{$any}) \] )? }x; |
16 | my $type_capture_parts = qr{ ($valid_chars+) (?: \[ ((??{$any})) \] )? }x; |
17 | my $type_with_parameter = qr{ $valid_chars+ \[ (??{$any}) \] }x; |
18 | |
19 | my $op_union = qr{ \s* \| \s* }x; |
20 | my $union = qr{ $type (?: $op_union $type )+ }x; |
21 | |
22 | ## New Stuff for structured types. |
23 | my $comma = qr{,}; |
24 | my $indirection = qr{=>}; |
25 | my $divider_tokens = qr{ $comma | $indirection }x; |
26 | my $structure_divider = qr{\s* $divider_tokens \s*}x; |
27 | my $structure_elements = qr{ ($type $structure_divider*)+ }x; |
28 | |
29 | $any = qr{ $type | $union | $structure_elements }x; |
30 | |
31 | ## New Proposed methods to parse and create |
32 | sub _parse_structured_type_constraint { |
33 | { no warnings 'void'; $any; } # force capture of interpolated lexical |
34 | |
35 | my($base, $elements) = ($_[0] =~ m{ $type_capture_parts }x); |
36 | return ($base, [split($structure_divider, $elements)]); |
37 | } |
38 | |
39 | is_deeply |
40 | [_parse_structured_type_constraint('ArrayRef[Int,Str]')], |
41 | ["ArrayRef", ["Int", "Str"]] |
42 | => 'Correctly parsed ArrayRef[Int,Str]'; |
43 | |
44 | is_deeply |
45 | [_parse_structured_type_constraint('ArrayRef[ArrayRef[Int],Str]')], |
46 | ["ArrayRef", ["ArrayRef[Int]", "Str"]] |
47 | => 'Correctly parsed ArrayRef[ArrayRef[Int],Str]'; |
48 | |
49 | is_deeply |
50 | [_parse_structured_type_constraint('HashRef[key1 => Int, key2=>Int, key3=>ArrayRef[Int]]')], |
51 | ["HashRef", ["key1", "Int", "key2", "Int", "key3", "ArrayRef[Int]"]] |
52 | => 'Correctly parsed HashRef[key1 => Int, key2=>Int, key3=>ArrayRef[Int]]'; |
53 | |
54 | } |
55 | |