1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception::LessClever;
use Data::Dumper;
use Carp;
our $CLASS;
our $RCLASS;
BEGIN {
$CLASS = 'Devel::Declare::Parser';
$RCLASS = 'Devel::Declare::Parser::Emulate';
use_ok( $CLASS );
use_ok( $RCLASS );
}
my $one = $RCLASS->new( 'test', 'test', 10 );
$one->line( qq/my \$xxx = test apple boy => "aaaaa" 'bbbb', (a => "b") ['a', 'b'] . \$xxx \%hash \@array \*glob Abc::DEF::HIJ { ... }/ );
$one->process;
is_deeply(
$one->parts,
[
[ 'apple', undef ],
[ 'boy', undef ],
'=>',
[ 'aaaaa', '"' ],
[ 'bbbb', "'" ],
',',
[ 'a => "b"', '(' ],
[ "'a', 'b'", '[' ],
'.',
'$xxx',
'%hash',
'@array',
'*glob',
[ 'Abc::DEF::HIJ', undef ],
],
"Parsed properly"
);
like(
$one->line(),
qr/my \$xxx = test\s*\('apple', 'boy', =>, "aaaaa", 'bbbb', ,, \(a => "b"\), \['a', 'b'\], ., \$xxx, \%hash, \@array, \*glob, 'Abc::DEF::HIJ', sub \{ BEGIN \{ .*\->_edit_block_end\('.*'\) \}; \.\.\. \} \);/,
"Got new line"
);
$one = $RCLASS->new( 'test', 'test', 0 );
$one->line( qq/test apple boy;/ );
$one->process;
is_deeply(
$one->parts,
[
[ 'apple', undef ],
[ 'boy', undef ],
],
"Parts"
);
like(
$one->line,
qr/^test\s*\('apple', 'boy'\);/,
"Non-codeblock"
);
$one = $RCLASS->new( 'test', 'test', 0 );
$one->line( <<EOT );
test
apple
=>
(
blah => 'blah',
uhg => sub {
aaa(
'aaa'
);
},
);
EOT
$one->process;
is( $one->line, <<EOT, "umodified arrow ( form" );
test
apple
=>
(
blah => 'blah',
uhg => sub {
aaa(
'aaa'
);
},
);
EOT
done_testing;
1;
|
