diff options
Diffstat (limited to 't/ext.t')
| -rw-r--r-- | t/ext.t | 161 |
1 files changed, 161 insertions, 0 deletions
@@ -0,0 +1,161 @@ +#!/usr/bin/perl -w + +use strict; +use lib 't/lib'; +use MBTest; + +my @unix_splits = + ( + { q{one t'wo th'ree f"o\"ur " "five" } => [ 'one', 'two three', 'fo"ur ', 'five' ] }, + { q{ foo bar } => [ 'foo', 'bar' ] }, + { q{ D\'oh f\{g\'h\"i\]\* } => [ "D'oh", "f{g'h\"i]*" ] }, + { q{ D\$foo } => [ 'D$foo' ] }, + { qq{one\\\ntwo} => [ "one\ntwo" ] }, # TODO + ); + +my @win_splits = + ( + { 'a" "b\\c" "d' => [ 'a b\c d' ] }, + { '"a b\\c d"' => [ 'a b\c d' ] }, + { '"a b"\\"c d"' => [ 'a b"c', 'd' ] }, + { '"a b"\\\\"c d"' => [ 'a b\c d' ] }, + { '"a"\\"b" "a\\"b"' => [ 'a"b a"b' ] }, + { '"a"\\\\"b" "a\\\\"b"' => [ 'a\b', 'a\b' ] }, + { '"a"\\"b a\\"b"' => [ 'a"b', 'a"b' ] }, + { 'a"\\"b" "a\\"b' => [ 'a"b', 'a"b' ] }, + { 'a"\\"b" "a\\"b' => [ 'a"b', 'a"b' ] }, + { 'a b' => [ 'a', 'b' ] }, + { 'a"\\"b a\\"b' => [ 'a"b a"b' ] }, + { '"a""b" "a"b"' => [ 'a"b ab' ] }, + { '\\"a\\"' => [ '"a"' ] }, + { '"a"" "b"' => [ 'a"', 'b' ] }, + { 'a"b' => [ 'ab' ] }, + { 'a""b' => [ 'ab' ] }, + { 'a"""b' => [ 'a"b' ] }, + { 'a""""b' => [ 'a"b' ] }, + { 'a"""""b' => [ 'a"b' ] }, + { 'a""""""b' => [ 'a""b' ] }, + { '"a"b"' => [ 'ab' ] }, + { '"a""b"' => [ 'a"b' ] }, + { '"a"""b"' => [ 'a"b' ] }, + { '"a""""b"' => [ 'a"b' ] }, + { '"a"""""b"' => [ 'a""b' ] }, + { '"a""""""b"' => [ 'a""b' ] }, + { '' => [ ] }, + { ' ' => [ ] }, + { '""' => [ '' ] }, + { '" "' => [ ' ' ] }, + { '""a' => [ 'a' ] }, + { '""a b' => [ 'a', 'b' ] }, + { 'a""' => [ 'a' ] }, + { 'a"" b' => [ 'a', 'b' ] }, + { '"" a' => [ '', 'a' ] }, + { 'a ""' => [ 'a', '' ] }, + { 'a "" b' => [ 'a', '', 'b' ] }, + { 'a " " b' => [ 'a', ' ', 'b' ] }, + { 'a " b " c' => [ 'a', ' b ', 'c' ] }, +); + +plan tests => 9 + 4*@unix_splits + 4*@win_splits; + +blib_load('Module::Build'); +blib_load('Module::Build::Platform::Unix'); +blib_load('Module::Build::Platform::Windows'); + +######################### + +# Should always return an array unscathed +foreach my $platform ('', '::Platform::Unix', '::Platform::Windows') { + my $pkg = "Module::Build$platform"; + my @result = $pkg->split_like_shell(['foo', 'bar', 'baz']); + is @result, 3, "Split using $pkg"; + is "@result", "foo bar baz", "Split using $pkg"; +} + +# I think 3.24 isn't actually the majik version, my 3.23 seems to pass... +my $low_TPW_version = Text::ParseWords->VERSION < 3.24; +foreach my $test (@unix_splits) { + # Text::ParseWords bug: + local $TODO = $low_TPW_version && ((keys %$test)[0] =~ m{\\\n}); + + do_split_tests('Module::Build::Platform::Unix', $test); +} + +foreach my $test (@win_splits) { + do_split_tests('Module::Build::Platform::Windows', $test); +} + + +{ + # Make sure read_args() functions properly as a class method + my @args = qw(foo=bar --food bard --foods=bards); + my ($args) = Module::Build->read_args(@args); + is_deeply($args, {foo => 'bar', food => 'bard', foods => 'bards', ARGV => []}); +} + +{ + # Make sure data can make a round-trip through unparse_args() and read_args() + my %args = (foo => 'bar', food => 'bard', config => {a => 1, b => 2}, ARGV => []); + my ($args) = Module::Build->read_args( Module::Build->unparse_args(\%args) ); + is_deeply($args, \%args); +} + +{ + # Make sure data can make a round-trip through an external perl + # process, which can involve the shell command line + + # silence the printing for easier matching + local *Module::Build::log_info = sub {}; + + my @data = map values(%$_), @unix_splits, @win_splits; + for my $d (@data) { + my $out = stdout_of + ( sub { + Module::Build->run_perl_script('-le', [], ['print join " ", map "{$_}", @ARGV', @$d]); + } ); + chomp $out; + is($out, join(' ', map "{$_}", @$d), "perl round trip for ".join('',map "{$_}", @$d)); + } +} + +{ + # Make sure data can make a round-trip through an external backtick + # process, which can involve the shell command line + + # silence the printing for easier matching + local *Module::Build::log_info = sub {}; + + my @data = map values(%$_), @unix_splits, @win_splits; + for my $d (@data) { + chomp(my $out = Module::Build->_backticks($^X, '-le', 'print join " ", map "{$_}", @ARGV', @$d)); + is($out, join(' ', map "{$_}", @$d), "backticks round trip for ".join('',map "{$_}", @$d)); + } +} + +{ + # Make sure run_perl_script() propagates @INC + my $dir = MBTest->tmpdir; + if ($^O eq 'VMS') { + # VMS can store INC paths in Unix format with out the trailing + # directory delimiter. + $dir = VMS::Filespec::unixify($dir); + $dir =~ s#/$##; + } + local @INC = ($dir, @INC); + my $output = stdout_of( sub { Module::Build->run_perl_script('-le', [], ['print for @INC']) } ); + like $output, qr{^\Q$dir\E}m; +} + +################################################################## +sub do_split_tests { + my ($package, $test) = @_; + + my ($string, $expected) = %$test; + my @result = $package->split_like_shell($string); + is( 0 + grep( !defined(), @result ), # all defined + 0, + "'$string' result all defined" ); + is_deeply(\@result, $expected) or + diag("$package split_like_shell error \n" . + ">$string< is not splitting as >" . join("|", @$expected) . '<'); +} |