nqp_spawn.diff

diff --git a/src/vm/parrot/QAST/Operations.nqp b/src/vm/parrot/QAST/Operations.nqp
index a9da22d..8ea7eb9 100644
--- a/src/vm/parrot/QAST/Operations.nqp
+++ b/src/vm/parrot/QAST/Operations.nqp
@@ -2510,6 +2510,7 @@ QAST::Operations.add_core_pirop_mapping('nfarunalt', 'nqp_nfa_run_alt', '0PsiPPP
 # process related opcodes
 QAST::Operations.add_core_pirop_mapping('exit', 'exit', '0i', :inlinable(1));
 QAST::Operations.add_core_pirop_mapping('sleep', 'sleep', '0n', :inlinable(1));
+QAST::Operations.add_core_pirop_mapping('spawn', 'nqp_spawn', 'IPsP'); 
 QAST::Operations.add_core_pirop_mapping('shell', 'nqp_shell', 'IssP');
 QAST::Operations.add_core_pirop_mapping('getenvhash', 'nqp_getenvhash', 'P');
 
diff --git a/src/vm/parrot/ops/nqp.ops b/src/vm/parrot/ops/nqp.ops
index ee58e3c..fd989ac 100644
--- a/src/vm/parrot/ops/nqp.ops
+++ b/src/vm/parrot/ops/nqp.ops
@@ -340,11 +340,9 @@ static char * pack_env_hash(Parrot_Interp interp, PMC* hash_pmc) {
     Hash *hash = VTABLE_get_pointer(interp, hash_pmc);
     STRING *equal = Parrot_str_new_constant(interp, "=");
     STRING *key, *value, *env_var, *env_var_with_null;
-    INTVAL hash_size = Parrot_hash_size(interp, hash);
     STRING *packed = Parrot_str_new_constant(interp, "");
     STRING *null = Parrot_str_new(interp, "\0", 1);
 
-    
     /* Parrot_hash_value_to_string is not exported*/
     parrot_hash_iterate(hash,
         key = (STRING *)_bucket->key;
@@ -356,6 +354,199 @@ static char * pack_env_hash(Parrot_Interp interp, PMC* hash_pmc) {
     return Parrot_str_to_cstring(interp, packed);
 }
 
+static char **pack_arg_array(Parrot_Interp interp, PMC* array_pmc) {
+    INTVAL array_size = VTABLE_elements(interp, array_pmc);
+    char **packed     = (char **)mem_sys_allocate((array_size + 1) * sizeof(char *));
+    INTVAL i = 0;
+
+    if (array_size > 0) {
+        for (i = 0; i < array_size; i++) {
+            PMC *pmc          = VTABLE_get_pmc_keyed_int(interp, array_pmc, i);
+            STRING *str       = (STRING *)VTABLE_get_string(interp, pmc);
+            (char *)packed[i] = Parrot_str_to_cstring(interp, str);
+        }
+    }
+    packed[i] = NULL;
+
+    return packed;
+}
+
+static int is_space(char c) {
+    return c == 0x09 || c == 0x0A || c == 0x0B
+        || c == 0x0C || c == 0x0D || c == 0x20
+        || c == 0x85;
+}
+
+static char *find_next_space(const char *s) {
+    short in_quotes = 0;
+    while (*s) {
+    /* ignore doubled backslashes, or backslash+quote */
+    if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
+        s += 2;
+    }
+    /* keep track of when we're within quotes */
+    else if (*s == '"') {
+        s++;
+        in_quotes = !in_quotes;
+    }
+    /* break it up only at spaces that aren't in quotes */
+    else if (!in_quotes && is_space(*s))
+        return (char*)s;
+    else
+        s++;
+    }
+    return (char*)s;
+}
+
+/* Autoquoting command-line arguments for nqp::spawn. */
+static char *create_command_line(const char *const *args) {
+    int index, argc;
+    char *cmd, *ptr;
+    const char *arg;
+    size_t len = 0;
+    short bat_file = 0;
+    short cmd_shell = 0;
+    short dumb_shell = 0;
+    short extra_quotes = 0;
+    short quote_next = 0;
+    char *cname = (char*)args[0];
+    size_t clen = strlen(cname);
+
+    /* The NT cmd.exe shell has the following peculiarity that needs to be
+     * worked around. It strips a leading and trailing dquote when any
+     * of the following is true:
+     * 1. the /S switch was used
+     * 2. there are more than two dquotes
+     * 3. there is a special character from this set: &<>()@^|
+     * 4. no whitespace characters within the two dquotes
+     * 5. string between two dquotes isn't an executable file
+     * To work around this, we always add a leading and trailing dquote
+     * to the string, if the first argument is either "cmd.exe" or "cmd",
+     * and there were at least two or more arguments passed to cmd.exe
+     * (not including switches).
+     * XXX the above rules (from "cmd /?") don't seem to be applied
+     * always, making for the convolutions below :-(
+     */
+
+    if (cname) {
+        if (!clen)
+            clen = strlen(cname);
+
+        if (clen > 4
+        && (stricmp(&cname[clen-4], ".bat") == 0
+        || (stricmp(&cname[clen-4], ".cmd") == 0))) {
+            bat_file = 1;
+            len     += 3;
+        }
+        else {
+            char *exe = strrchr(cname, '/');
+            char *exe2 = strrchr(cname, '\\');
+            if (exe2 > exe)
+                exe = exe2;
+            if (exe)
+                ++exe;
+            else
+                exe = cname;
+
+            if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
+                cmd_shell = 1;
+                len      += 3;
+            }
+            else if (stricmp(exe, "command.com") == 0
+            || stricmp(exe, "command") == 0) {
+                dumb_shell = 1;
+            }
+        }
+    }
+
+    for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+        size_t curlen = strlen(arg);
+        if (!(arg[0] == '"' && arg[curlen-1] == '"'))
+            len += 2;	/* assume quoting needed (worst case) */
+        len += curlen + 1;
+    }
+
+    argc = index;
+    cmd  = (char *)mem_sys_allocate(len * sizeof(char));
+    ptr  = cmd;
+
+    if (bat_file) {
+        *ptr++       = '"';
+        extra_quotes = 1;
+    }
+
+    for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+        short do_quote = 0;
+        size_t curlen  = strlen(arg);
+
+        /* we want to protect empty arguments and ones with spaces with
+         * dquotes, but only if they aren't already there */
+        if (!dumb_shell) {
+            if (!curlen) {
+                do_quote = 1;
+            }
+            else if (quote_next) {
+                /* see if it really is multiple arguments pretending to
+                 * be one and force a set of quotes around it */
+                if (*find_next_space(arg))
+                    do_quote = 1;
+            }
+            else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
+                size_t i = 0;
+                while (i < curlen) {
+                    /* is space */
+                    if (is_space(arg[i])) {
+                        do_quote = 1;
+                    }
+                    else if (arg[i] == '"') {
+                        do_quote = 0;
+                        break;
+                    }
+                    i++;
+                }
+            }
+        }
+
+        if (do_quote)
+            *ptr++ = '"';
+
+        strcpy(ptr, arg);
+        ptr += curlen;
+
+        if (do_quote)
+            *ptr++ = '"';
+
+        if (args[index+1])
+            *ptr++ = ' ';
+
+        if (!extra_quotes
+        && cmd_shell
+        && curlen >= 2
+        && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
+        && stricmp(arg+curlen-2, "/c") == 0) {
+            /* is there a next argument? */
+            if (args[index+1]) {
+                /* are there two or more next arguments? */
+                if (args[index+2]) {
+                    *ptr++ = '"';
+                    extra_quotes = 1;
+                }
+                else {
+                    /* single argument, force quoting if it has spaces */
+                    quote_next = 1;
+                }
+            }
+        }
+    }
+
+    if (extra_quotes)
+        *ptr++ = '"';
+
+    *ptr = '\0';
+
+    return cmd;
+}
+
 static INTVAL Run_OS_Command(PARROT_INTERP, STRING *command, PMC *env_hash)
 {
     DWORD status = 0;
@@ -428,6 +619,8 @@ static void free_packed_env(char **env) {
     }
     mem_sys_free(env);
 }
+
+
 static INTVAL Run_OS_Command(PARROT_INTERP, STRING *command, PMC *env_hash)
 {
     pid_t child;
@@ -462,6 +655,199 @@ static INTVAL Run_OS_Command(PARROT_INTERP, STRING *command, PMC *env_hash)
     /* make gcc happy */
     return 1;
 }
+
+static char **pack_arg_array(Parrot_Interp interp, PMC* array_pmc) {
+    INTVAL array_size = VTABLE_elements(interp, array_pmc);
+    char **packed     = (char **)mem_sys_allocate((array_size + 1) * sizeof(char *));
+    INTVAL i = 0;
+
+    if (array_size > 0) {
+        for (i = 0; i < array_size; i++) {
+            PMC *pmc    = VTABLE_get_pmc_keyed_int(interp, array_pmc, i);
+            STRING *str = (STRING *)VTABLE_get_string(interp, pmc);
+            packed[i]   = Parrot_str_to_cstring(interp, str);
+        }
+    }
+    packed[i] = NULL;
+
+    return packed;
+}
+
+static int is_space(unsigned short c) {
+    return c == 0x09 || c == 0x0A || c == 0x0B
+        || c == 0x0C || c == 0x0D || c == 0x20
+        || c == 0x85;
+}
+
+static char *find_next_space(const char *s) {
+    short in_quotes = 0;
+    while (*s) {
+    /* ignore doubled backslashes, or backslash+quote */
+    if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
+        s += 2;
+    }
+    /* keep track of when we're within quotes */
+    else if (*s == '"') {
+        s++;
+        in_quotes = !in_quotes;
+    }
+    /* break it up only at spaces that aren't in quotes */
+    else if (!in_quotes && is_space((unsigned short)*s))
+        return (char*)s;
+    else
+        s++;
+    }
+    return (char*)s;
+}
+
+/* Autoquoting command-line arguments for nqp::spawn. */
+static char *create_command_line(const char *const *args) {
+    int index, argc;
+    char *cmd, *ptr;
+    const char *arg;
+    size_t len = 0;
+    short bat_file = 0;
+    short cmd_shell = 0;
+    short dumb_shell = 0;
+    short extra_quotes = 0;
+    short quote_next = 0;
+    char *cname = (char*)args[0];
+    size_t clen = strlen(cname);
+
+    /* The NT cmd.exe shell has the following peculiarity that needs to be
+     * worked around. It strips a leading and trailing dquote when any
+     * of the following is true:
+     * 1. the /S switch was used
+     * 2. there are more than two dquotes
+     * 3. there is a special character from this set: &<>()@^|
+     * 4. no whitespace characters within the two dquotes
+     * 5. string between two dquotes isn't an executable file
+     * To work around this, we always add a leading and trailing dquote
+     * to the string, if the first argument is either "cmd.exe" or "cmd",
+     * and there were at least two or more arguments passed to cmd.exe
+     * (not including switches).
+     * XXX the above rules (from "cmd /?") don't seem to be applied
+     * always, making for the convolutions below :-(
+     */
+
+/*    if (cname) {
+        if (!clen)
+            clen = strlen(cname);
+
+        if (clen > 4
+        && (stricmp(&cname[clen-4], ".bat") == 0
+        || (stricmp(&cname[clen-4], ".cmd") == 0))) {
+            bat_file = 1;
+            len     += 3;
+        }
+        else {
+            char *exe = strrchr(cname, '/');
+            char *exe2 = strrchr(cname, '\\');
+            if (exe2 > exe)
+                exe = exe2;
+            if (exe)
+                ++exe;
+            else
+                exe = cname;
+
+            if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
+                cmd_shell = 1;
+                len      += 3;
+            }
+            else if (stricmp(exe, "command.com") == 0
+            || stricmp(exe, "command") == 0) {
+                dumb_shell = 1;
+            }
+        }
+    }*/
+
+    for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+        size_t curlen = strlen(arg);
+        if (!(arg[0] == '"' && arg[curlen-1] == '"'))
+            len += 2;	/* assume quoting needed (worst case) */
+        len += curlen + 1;
+    }
+
+    argc = index;
+    cmd  = (char *)mem_sys_allocate(len * sizeof(char));
+    ptr  = cmd;
+
+    /*if (bat_file) {
+        *ptr++       = '"';
+        extra_quotes = 1;
+    }*/
+
+    for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+        short do_quote = 0;
+        size_t curlen  = strlen(arg);
+
+        /* we want to protect empty arguments and ones with spaces with
+         * dquotes, but only if they aren't already there */
+        if (!dumb_shell) {
+            if (!curlen) {
+                do_quote = 1;
+            }
+            else if (quote_next) {
+                /* see if it really is multiple arguments pretending to
+                 * be one and force a set of quotes around it */
+                if (*find_next_space(arg))
+                    do_quote = 1;
+            }
+            else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
+                size_t i = 0;
+                while (i < curlen) {
+                    /* is space */
+                    if (is_space((unsigned short)arg[i])) {
+                        do_quote = 1;
+                    }
+                    else if (arg[i] == '"') {
+                        do_quote = 0;
+                        break;
+                    }
+                    i++;
+                }
+            }
+        }
+
+        if (do_quote)
+            *ptr++ = '"';
+
+        strcpy(ptr, arg);
+        ptr += curlen;
+
+        if (do_quote)
+            *ptr++ = '"';
+
+        if (args[index+1])
+            *ptr++ = ' ';
+
+        if (!extra_quotes
+        && cmd_shell
+        && curlen >= 2
+        && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
+        /*&& stricmp(arg+curlen-2, "/c") == 0*/) {
+            /* is there a next argument? */
+            if (args[index+1]) {
+                /* are there two or more next arguments? */
+                if (args[index+2]) {
+                    *ptr++ = '"';
+                    extra_quotes = 1;
+                }
+                else {
+                    /* single argument, force quoting if it has spaces */
+                    quote_next = 1;
+                }
+            }
+        }
+    }
+
+    if (extra_quotes)
+        *ptr++ = '"';
+
+    *ptr = '\0';
+
+    return cmd;
+}
 #endif
 
 /*
@@ -3540,6 +3926,20 @@ inline op nqp_delete_f(out INT, in STR) :base_core {
 #endif
 }
 
+inline op nqp_spawn(out INT, in PMC, in STR, in PMC) {
+    STRING *dir            = $3;
+    PMC *env               = $4;
+    char *const *argv      = pack_arg_array(interp, $2);
+    char *args             = create_command_line(argv);
+    STRING *command        = Parrot_str_new(interp, args, 0);
+    STRING * const old_cwd = Parrot_file_getcwd(interp);
+    Parrot_str_free_cstring(args);
+
+    Parrot_file_chdir(interp, dir);
+    $1 = Run_OS_Command(interp, command, env);
+    Parrot_file_chdir(interp, old_cwd);
+}
+
 inline op nqp_shell(out INT, in STR, in STR, in PMC) {
      STRING *command = $2;  
      STRING *dir = $3;  

rakudo_spawn.diff

diff --git a/src/core/OS.pm b/src/core/OS.pm
index f8e345f..4d094d1 100644
--- a/src/core/OS.pm
+++ b/src/core/OS.pm
@@ -1,3 +1,30 @@
 sub gethostname( --> Str){
     return nqp::p6box_s(nqp::gethostname());
 }
+
+my class Proc::Status {
+    has $.exit;
+    has $.pid;
+    has $.signal;
+    
+    #~ method exit()   { $!exit   }
+    #~ method pid()    { $!pid    }
+    #~ method signal() { $!signal }
+    
+    proto method status(|) { * }
+    multi method status($new_status) {
+        $!exit   = $new_status +> 8;
+        $!signal = $new_status +& 0xFF;
+    }
+    multi method status() {
+        ($!exit +< 8) +| $!signal
+    }
+    
+    method Numeric {
+        $!exit
+    }
+    
+    method Bool {
+        $!exit == 0
+    }
+}
diff --git a/src/core/control.pm b/src/core/control.pm
index 91437d9..1c011be 100644
--- a/src/core/control.pm
+++ b/src/core/control.pm
@@ -166,43 +166,26 @@ sub exit($status = 0) {
     $status;
 }
 
+my class Proc::Status { ... }
+
 sub run(*@args ($, *@)) {
-    my $error_code;
+    my $status = Proc::Status.new( :exit(255) );
     try {
-#?if parrot
-        nqp::chdir($*CWD);
-        $error_code = nqp::p6box_i(
-            pir::spawnw__IP(
-                nqp::getattr(
-                    @args.eager,
-                    List,
-                    '$!items'
-                )
-            )
-        ) +> 8;
-#?endif
-#?if !parrot
         my Mu $hash := nqp::getattr(%*ENV, EnumMap, '$!storage');
-        $error_code = nqp::p6box_i(
+        $status.status( nqp::p6box_i(
             nqp::spawn(nqp::getattr(@args.eager, List, '$!items'), $*CWD.Str, $hash)
-        ) +> 8;
-#?endif
-        CATCH {
-            default {
-                $error_code = 1;
-            }
-        }
+        ) );
     }
-    $error_code but !$error_code;
+    $status
 }
 
 sub shell($cmd) {
-    my $status = 255;
+    my $status = Proc::Status.new( :exit(255) );
     try {
         my Mu $hash := nqp::getattr(%*ENV, EnumMap, '$!storage');
-        $status = nqp::p6box_i(nqp::shell($cmd, $*CWD.Str, $hash));
+        $status.status( nqp::p6box_i(nqp::shell($cmd, $*CWD.Str, $hash)) );
     }
-    $status;
+    $status
 }
 
 # XXX: Temporary definition of $Inf and $NaN until we have constants ava

spectest.diff

diff --git a/packages/Test/Util.pm b/packages/Test/Util.pm
index 6c8eed1..71d11df 100644
--- a/packages/Test/Util.pm
+++ b/packages/Test/Util.pm
@@ -99,7 +99,7 @@ sub get_out( Str $code, Str $input?, :@args, :@compiler-args) is export {
         $cmd ~= $fnbase ~ '.code'  if $code.defined;
         $cmd ~= " @actual_args.join(' ') < $fnbase.in > $fnbase.out 2> $fnbase.err";
         # diag("Command line: $cmd");
-        %out<status> = shell( $cmd );
+        %out<status> = +shell( $cmd ) +< 8;
         %out<out> = slurp "$fnbase.out";
         %out<err> = slurp "$fnbase.err";