lib/Module/Build/t/ext.t

   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
   7 use Module::Build;
   8
   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'                         ] },
  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
  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
  61 plan tests => 10 + 4*@unix_splits + 4*@win_splits;
  62
  63 ensure_blib('Module::Build');
  64
  65 #########################
  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
  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;
  77 use Module::Build::Platform::Unix;
  78 foreach my $test (@unix_splits) {
  79   # Text::ParseWords bug:
  80   local $TODO = $low_TPW_version && ((keys %$test)[0] =~ m{\\\n});
  81
  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 {
 106   # Make sure data can make a round-trip through an external perl
 107   # process, which can involve the shell command line
 108
 109   # silence the printing for easier matching
 110   local *Module::Build::log_info = sub {};
 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   # silence the printing for easier matching
 128   local *Module::Build::log_info = sub {};
 129
 130   my @data = map values(%$_), @unix_splits, @win_splits;
 131   for my $d (@data) {
 132     chomp(my $out = Module::Build->_backticks('perl', '-le', 'print join " ", map "{$_}", @ARGV', @$d));
 133     is($out, join(' ', map "{$_}", @$d), "backticks round trip for ".join('',map "{$_}", @$d));
 134   }
 135 }
 136
 137 {
 138   # Make sure run_perl_script() propagates @INC
 139   my $dir = 'whosiewhatzit';
 140   mkdir $dir, 0777;
 141   local @INC = ($dir, @INC);
 142   my $output = stdout_of( sub { Module::Build->run_perl_script('-le', [], ['print for @INC']) } );
 143   like $output, qr{^$dir}m;
 144   rmdir $dir;
 145 }
 146
 147 ##################################################################
 148 sub do_split_tests {
 149   my ($package, $test) = @_;
 150
 151   my ($string, $expected) = %$test;
 152   my @result = $package->split_like_shell($string);
 153   is( 0 + grep( !defined(), @result ), # all defined
 154       0,
 155       "'$string' result all defined" );
 156   is_deeply(\@result, $expected) or
 157     diag("$package split_like_shell error \n" .
 158       ">$string< is not splitting as >" . join("|", @$expected) . '<');
 159 }