Commit | Line | Data |
bb4e9162 |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
4 | use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib'; |
5 | use MBTest; |
6 | |
738349a8 |
7 | use Module::Build; |
8 | |
bb4e9162 |
9 | my @unix_splits = |
10 | ( |
11 | { q{one t'wo th'ree f"o\"ur " "five" } => [ 'one', 'two three', 'fo"ur ', 'five' ] }, |
12 | { q{ foo bar } => [ 'foo', 'bar' ] }, |
738349a8 |
13 | { q{ D\'oh f\{g\'h\"i\]\* } => [ "D'oh", "f{g'h\"i]*" ] }, |
14 | { q{ D\$foo } => [ 'D$foo' ] }, |
15 | { qq{one\\\ntwo} => [ "one\ntwo" ] }, # TODO |
bb4e9162 |
16 | ); |
17 | |
18 | my @win_splits = |
19 | ( |
20 | { 'a" "b\\c" "d' => [ 'a b\c d' ] }, |
21 | { '"a b\\c d"' => [ 'a b\c d' ] }, |
22 | { '"a b"\\"c d"' => [ 'a b"c', 'd' ] }, |
23 | { '"a b"\\\\"c d"' => [ 'a b\c d' ] }, |
24 | { '"a"\\"b" "a\\"b"' => [ 'a"b a"b' ] }, |
25 | { '"a"\\\\"b" "a\\\\"b"' => [ 'a\b', 'a\b' ] }, |
26 | { '"a"\\"b a\\"b"' => [ 'a"b', 'a"b' ] }, |
27 | { 'a"\\"b" "a\\"b' => [ 'a"b', 'a"b' ] }, |
28 | { 'a"\\"b" "a\\"b' => [ 'a"b', 'a"b' ] }, |
29 | { 'a b' => [ 'a', 'b' ] }, |
30 | { 'a"\\"b a\\"b' => [ 'a"b a"b' ] }, |
31 | { '"a""b" "a"b"' => [ 'a"b ab' ] }, |
32 | { '\\"a\\"' => [ '"a"' ] }, |
33 | { '"a"" "b"' => [ 'a"', 'b' ] }, |
34 | { 'a"b' => [ 'ab' ] }, |
35 | { 'a""b' => [ 'ab' ] }, |
36 | { 'a"""b' => [ 'a"b' ] }, |
37 | { 'a""""b' => [ 'a"b' ] }, |
38 | { 'a"""""b' => [ 'a"b' ] }, |
39 | { 'a""""""b' => [ 'a""b' ] }, |
40 | { '"a"b"' => [ 'ab' ] }, |
41 | { '"a""b"' => [ 'a"b' ] }, |
42 | { '"a"""b"' => [ 'a"b' ] }, |
43 | { '"a""""b"' => [ 'a"b' ] }, |
44 | { '"a"""""b"' => [ 'a""b' ] }, |
45 | { '"a""""""b"' => [ 'a""b' ] }, |
46 | { '' => [ ] }, |
47 | { ' ' => [ ] }, |
48 | { '""' => [ '' ] }, |
49 | { '" "' => [ ' ' ] }, |
50 | { '""a' => [ 'a' ] }, |
51 | { '""a b' => [ 'a', 'b' ] }, |
52 | { 'a""' => [ 'a' ] }, |
53 | { 'a"" b' => [ 'a', 'b' ] }, |
54 | { '"" a' => [ '', 'a' ] }, |
55 | { 'a ""' => [ 'a', '' ] }, |
56 | { 'a "" b' => [ 'a', '', 'b' ] }, |
57 | { 'a " " b' => [ 'a', ' ', 'b' ] }, |
58 | { 'a " b " c' => [ 'a', ' b ', 'c' ] }, |
59 | ); |
60 | |
738349a8 |
61 | plan tests => 10 + 4*@unix_splits + 4*@win_splits; |
bb4e9162 |
62 | |
738349a8 |
63 | ensure_blib('Module::Build'); |
bb4e9162 |
64 | |
738349a8 |
65 | ######################### |
bb4e9162 |
66 | |
67 | # Should always return an array unscathed |
68 | foreach my $platform ('', '::Platform::Unix', '::Platform::Windows') { |
69 | my $pkg = "Module::Build$platform"; |
70 | my @result = $pkg->split_like_shell(['foo', 'bar', 'baz']); |
71 | is @result, 3, "Split using $pkg"; |
72 | is "@result", "foo bar baz", "Split using $pkg"; |
73 | } |
74 | |
738349a8 |
75 | # I think 3.24 isn't actually the majik version, my 3.23 seems to pass... |
76 | my $low_TPW_version = Text::ParseWords->VERSION < 3.24; |
bb4e9162 |
77 | use Module::Build::Platform::Unix; |
78 | foreach my $test (@unix_splits) { |
738349a8 |
79 | # Text::ParseWords bug: |
80 | local $TODO = $low_TPW_version && ((keys %$test)[0] =~ m{\\\n}); |
81 | |
bb4e9162 |
82 | do_split_tests('Module::Build::Platform::Unix', $test); |
83 | } |
84 | |
85 | use Module::Build::Platform::Windows; |
86 | foreach my $test (@win_splits) { |
87 | do_split_tests('Module::Build::Platform::Windows', $test); |
88 | } |
89 | |
90 | |
91 | { |
92 | # Make sure read_args() functions properly as a class method |
93 | my @args = qw(foo=bar --food bard --foods=bards); |
94 | my ($args) = Module::Build->read_args(@args); |
95 | is_deeply($args, {foo => 'bar', food => 'bard', foods => 'bards', ARGV => []}); |
96 | } |
97 | |
98 | { |
99 | # Make sure data can make a round-trip through unparse_args() and read_args() |
100 | my %args = (foo => 'bar', food => 'bard', config => {a => 1, b => 2}, ARGV => []); |
101 | my ($args) = Module::Build->read_args( Module::Build->unparse_args(\%args) ); |
102 | is_deeply($args, \%args); |
103 | } |
104 | |
105 | { |
738349a8 |
106 | # Make sure data can make a round-trip through an external perl |
107 | # process, which can involve the shell command line |
108 | |
109 | # Holy crap, I can't believe this works: |
110 | local $Module::Build{properties}{quiet} = 1; |
111 | |
112 | my @data = map values(%$_), @unix_splits, @win_splits; |
113 | for my $d (@data) { |
114 | my $out = stdout_of |
115 | ( sub { |
116 | Module::Build->run_perl_script('-le', [], ['print join " ", map "{$_}", @ARGV', @$d]); |
117 | } ); |
118 | chomp $out; |
119 | is($out, join(' ', map "{$_}", @$d), "perl round trip for ".join('',map "{$_}", @$d)); |
120 | } |
121 | } |
122 | |
123 | { |
124 | # Make sure data can make a round-trip through an external backtick |
125 | # process, which can involve the shell command line |
126 | |
127 | local $Module::Build{properties}{quiet} = 1; |
128 | my @data = map values(%$_), @unix_splits, @win_splits; |
129 | for my $d (@data) { |
130 | chomp(my $out = Module::Build->_backticks('perl', '-le', 'print join " ", map "{$_}", @ARGV', @$d)); |
131 | is($out, join(' ', map "{$_}", @$d), "backticks round trip for ".join('',map "{$_}", @$d)); |
132 | } |
133 | } |
134 | |
135 | { |
bb4e9162 |
136 | # Make sure run_perl_script() propagates @INC |
77e96e88 |
137 | my $dir = 'whosiewhatzit'; |
138 | mkdir $dir, 0777; |
139 | local @INC = ($dir, @INC); |
738349a8 |
140 | my $output = stdout_of( sub { Module::Build->run_perl_script('-le', [], ['print for @INC']) } ); |
77e96e88 |
141 | like $output, qr{^$dir}m; |
142 | rmdir $dir; |
bb4e9162 |
143 | } |
144 | |
145 | ################################################################## |
146 | sub do_split_tests { |
147 | my ($package, $test) = @_; |
148 | |
149 | my ($string, $expected) = %$test; |
150 | my @result = $package->split_like_shell($string); |
151 | is( 0 + grep( !defined(), @result ), # all defined |
152 | 0, |
153 | "'$string' result all defined" ); |
738349a8 |
154 | is_deeply(\@result, $expected) or |
155 | diag("$package split_like_shell error \n" . |
156 | ">$string< is not splitting as >" . join("|", @$expected) . '<'); |
bb4e9162 |
157 | } |