[svn:Module-Build] r11190 - in Module-Build/trunk: . lib/Module/Build t

[kwilliams]

Author: kwilliams
Date: Fri May  2 13:32:29 2008
New Revision: 11190

Modified:
   Module-Build/trunk/Changes
   Module-Build/trunk/lib/Module/Build/Base.pm
   Module-Build/trunk/t/ext.t

Log:
Better shell quoting and testing thereof

Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes  (original)
+++ Module-Build/trunk/Changes  Fri May  2 13:32:29 2008
@@ -1,5 +1,9 @@
 Revision history for Perl extension Module::Build.
 
+ - Fixed a couple bugs in how we quote arguments to external processes
+   when they have to pass through the shell.  Also much more
+   thoroughly tested our quoting now.
+
  - Edited the Module::Build::API docs prose about the 'license' field
    in response to some comments on the module-authors mailing list.
 

Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm Fri May  2 13:32:29 2008
@@ -334,14 +334,14 @@
   my @quoted;
 
   for (@args) {
-    if ( /^[^\s*?!$<>;\\|'"\[\]\{\}]+$/ ) {
+    if ( /^[^\s*?!\$<>;\\|'"\[\]\{\}]+$/ ) {
       # Looks pretty safe
       push @quoted, $_;
     } else {
       # XXX this will obviously have to improve - is there already a
       # core module lying around that does proper quoting?
-      s/"/"'"'"/g;
-      push @quoted, qq("$_");
+      s/('+)/'"$1"'/g;
+      push @quoted, qq('$_');
     }
   }
 

Modified: Module-Build/trunk/t/ext.t
==============================================================================
--- Module-Build/trunk/t/ext.t  (original)
+++ Module-Build/trunk/t/ext.t  Fri May  2 13:32:29 2008
@@ -8,6 +8,9 @@
   (
    { 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"                      
     ] },
   );
 
 my @win_splits = 
@@ -53,7 +56,7 @@
    { 'a " b " c'            => [ 'a', ' b ', 'c' ] },
 );
 
-plan tests => 11 + [EMAIL PROTECTED] + [EMAIL PROTECTED];
+plan tests => 11 + [EMAIL PROTECTED] + [EMAIL PROTECTED];
 
 use_ok 'Module::Build';
 ensure_blib('Module::Build');
@@ -94,11 +97,41 @@
 }
 
 {
+  # Make sure data can make a round-trip through an external perl
+  # process, which can involve the shell command line
+
+  # Holy crap, I can't believe this works:
+  local $Module::Build{properties}{quiet} = 1;
+
+  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
+
+  local $Module::Build{properties}{quiet} = 1;
+  my @data = map values(%$_), @unix_splits, @win_splits;
+  for my $d (@data) {
+    chomp(my $out = Module::Build->_backticks('perl', '-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 = 'whosiewhatzit';
   mkdir $dir, 0777;
   local @INC = ($dir, @INC);
-  my $output = stdout_of( sub { Module::Build->run_perl_script('', ['-le', 
'print for @INC']) } );
+  my $output = stdout_of( sub { Module::Build->run_perl_script('-le', [], 
['print for @INC']) } );
   like $output, qr{^$dir}m;
   rmdir $dir;
 }