Make nqp::getenvhash() return a hash on parrot, document it and test …

…it a little.

docs/ops.markdown

@@ -11,3 +11,8 @@ Gets hold of the argument capture passed to the current block.
 (a future usecapture may invalidate it)
 It's valid to implement this exactly the same way as savecapture if there's no performance benefit to be had in a split.
 Used by the multi-dispatcher.
+
+# getenvhash()
+
+Returns a hash containing the environment variables.
+Changing the hash doesn't affect the environment variables

src/vm/parrot/QAST/Operations.nqp

@@ -2380,15 +2380,8 @@ QAST::Operations.add_core_pirop_mapping('nfarunalt', 'nqp_nfa_run_alt', '0PsiPPP
 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('shell', 'nqp_shell', 'IssP');
-QAST::Operations.add_core_op('getenvhash', -> $qastcomp, $op {
-    if +@($op) != 0 {
-        nqp::die('getenvhash requires no operands');
-    }
-    $qastcomp.as_post(QAST::VM.new(
-        :pirop('new__Ps'),
-        QAST::SVal.new( :value('Env') )
-    ))
-});
+QAST::Operations.add_core_pirop_mapping('getenvhash', 'nqp_getenvhash', 'P');
+
 QAST::Operations.add_core_op('getpid', -> $qastcomp, $op {
     if +@($op) != 0 {
         nqp::die('getpid requires no operands');

src/vm/parrot/ops/nqp.ops

@@ -320,6 +320,17 @@ static PMC* sub_find_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx)
     }
 }
 
+/* the Parrot env variables abstraction doesn't support traversing through all the env variables so we need this ifdef*/
+
+#ifndef WIN32
+#  ifdef __APPLE_CC__
+#    include <crt_externs.h>
+#    define environ (*_NSGetEnviron())
+#  else /* !__APPLE_CC__ */
+extern char **environ;
+#  endif /* __APPLE_CC__ */
+#endif /* !WIN32 */
+
 END_OPS_PREAMBLE
 
 /*
@@ -3376,6 +3387,24 @@ inline op nqp_shell(out INT, in STR, in STR, in PMC) {
      Parrot_file_chdir(interp, old_cwd);
 }
 
+inline op nqp_getenvhash(out PMC) {
+    PMC * const hash = Parrot_pmc_new(interp, enum_class_Hash);
+    INTVAL rv = 0;
+    $1 = hash;
+
+    while (environ[rv] != NULL) {
+        STRING * const envp  = Parrot_str_from_platform_cstring(interp, environ[rv]);
+        const INTVAL   delim = STRING_index(interp, envp, Parrot_str_new_constant(interp, "="), 0);
+        STRING* key = STRING_substr(interp, envp, 0, delim);
+        STRING * const value = Parrot_getenv(interp, key);
+        if (!STRING_IS_NULL(value)) {
+            PMC * const value_pmc = Parrot_pmc_new(interp, enum_class_String);
+            VTABLE_set_string_native(interp, value_pmc, value);
+            VTABLE_set_pmc_keyed_str(interp, hash, key, value_pmc);
+        }
+        rv++;
+    }
+}
 
 /*
 

t/nqp/78-shell.t

@@ -1,5 +1,15 @@
-plan(1);
+plan(4);
+
+my $a := nqp::getenvhash();
+$a<foo> := 123;
+my $b := nqp::getenvhash();
+$b<foo> := 456;
+
+ok(nqp::ishash($a),'nqp::getenvhash() returns a hash');
+ok($a<foo> == 123,'nqp::getenvhash() is a fresh hash');
+ok($b<foo> == 456,'nqp::getenvhash() is a fresh hash');
+
 my $tmp_file := "tmp";
 nqp::shell("echo Hello > $tmp_file",nqp::cwd(),nqp::getenvhash());
 my $output := slurp($tmp_file);
-ok($output ~~ /^Hello/);
+ok($output ~~ /^Hello/,'nqp::shell works with the echo shell command');