[m-rev.] for review: bugfix for io.set_environment_var/4

[Mark Brown]

Hi Peter,

Thanks for the review.

On Sat, Apr 16, 2016 at 1:28 PM, Peter Wang <novalazy at gmail.com> wrote:
> Since putenv is utterly broken, I suggest using setenv instead
> (and unsetenv if required).

The attached diff uses setenv on non-Windows platforms.

> Windows has SetEnvironmentVariable.  I have not been able to find
> documentation stating whether it duplicates its input, which hopefully
> means it does.
> https://msdn.microsoft.com/en-us/library/windows/desktop/ms686206(v=vs.85).aspx

This doesn't work with _wgetenv. I gather this is because
SetEnvironmentVariable modifies the process environment in the kernel,
whereas _wgetenv/_wputenv uses a copy of the environment in the C
runtime library. But there's a _wputenv_s in the C runtime library
which behaves like setenv and copies the string, so on Windows I have
used that.

I'll commit this soon if there are no objections.

Mark
-------------- next part --------------
commit d4847102b9854e96d183d9480b9083b183e57b7a
Author: Mark Brown <mark at mercurylang.org>
Date:   Fri Apr 15 22:11:13 2016 +1000

    Fix bug with io.set_environment_var/4.
    
    library/io.m:
    	Use setenv() and _wputenv_s() to set environment variables
    	on C backends. Unlike putenv() and _wputenv(), these can be
    	relied upon to copy their inputs, so the inputs can safely
    	be garbage collected after the call returns.
    
    tests/hard_coded/Mmakefile:
    tests/hard_coded/setenv.{m,exp}:
    	Test case. Only run in grades for which io.set_environment_var/4
    	succeeds.

diff --git a/library/io.m b/library/io.m
index 28fab1a..a243012 100644
--- a/library/io.m
+++ b/library/io.m
@@ -10228,7 +10228,7 @@ command_line_argument(_, "") :-
 % io.getenv and io.setenv.
 
 :- pragma foreign_decl("C", "
-#include <stdlib.h> /* for getenv() and putenv() */
+#include <stdlib.h> /* for getenv() and setenv() */
 ").
 
 :- pragma foreign_proc("C",
@@ -10280,24 +10280,16 @@ command_line_argument(_, "") :-
     end
 ").
 
-io.setenv(Var, Value) :-
-    impure io.putenv(Var ++ "=" ++ Value).
-
-    % io.putenv(VarString): If VarString is a string of the form "name=value",
-    % sets the environment variable name to the specified value. Fails if
-    % the operation does not work. This should only be called from io.setenv.
-    %
-:- impure pred io.putenv(string::in) is semidet.
-
 :- pragma foreign_proc("C",
-    io.putenv(VarAndValue::in),
+    io.setenv(Var::in, Value::in),
     [will_not_call_mercury, not_thread_safe, tabled_for_io,
         does_not_affect_liveness, no_sharing],
 "
 #ifdef MR_WIN32
-    SUCCESS_INDICATOR = (_wputenv(ML_utf8_to_wide(VarAndValue)) == 0);
+    SUCCESS_INDICATOR =
+        (_wputenv_s(ML_utf8_to_wide(Var), ML_utf8_to_wide(Value)) == 0);
 #else
-    SUCCESS_INDICATOR = (putenv(VarAndValue) == 0);
+    SUCCESS_INDICATOR = (setenv(Var, Value, 1) == 0);
 #endif
 ").
 
@@ -10313,17 +10305,6 @@ io.setenv(Var, Value) :-
     }
 ").
 
-:- pragma foreign_proc("C#",
-    io.putenv(_VarAndValue::in),
-    [will_not_call_mercury, tabled_for_io],
-"
-    // This procedure should never be called, as io.setenv/2 has been
-    // implemented directly for C#.
-    // This implementation is included only to suppress warnings.
-
-    throw new System.Exception(""io.putenv/1 not implemented for C#"");
-").
-
 :- pragma foreign_proc("Java",
     io.setenv(Var::in, Value::in),
     [will_not_call_mercury, tabled_for_io, may_not_duplicate],
@@ -10335,18 +10316,6 @@ io.setenv(Var, Value) :-
     SUCCESS_INDICATOR = false;
 ").
 
-:- pragma foreign_proc("Java",
-    io.putenv(VarAndValue::in),
-    [will_not_call_mercury, tabled_for_io, may_not_duplicate],
-"
-    // This procedure should never be called, as io.setenv/2 has been
-    // implemented directly for Java.
-    // This implementation is included only to suppress warnings.
-
-    io.ML_throw_io_error(
-        ""io.putenv/1 not implemented for Java: "" + VarAndValue);
-").
-
 :- pragma foreign_proc("Erlang",
     io.setenv(Var::in, Value::in),
     [will_not_call_mercury, tabled_for_io],
@@ -10357,17 +10326,6 @@ io.setenv(Var, Value) :-
     SUCCESS_INDICATOR = true
 ").
 
-:- pragma foreign_proc("Erlang",
-    io.putenv(VarAndValue::in),
-    [will_not_call_mercury, tabled_for_io],
-"
-    % This procedure should never be called, as io.setenv/2 has been
-    % implemented directly for Erlang.
-    % This implementation is included only to suppress warnings.
-
-    throw({""io.putenv/1 not implemented for Erlang: "" ++ VarAndValue})
-").
-
 %---------------------------------------------------------------------------%
 
 make_temp(Name, !IO) :-
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 1e19c0e..0e6f519 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -707,6 +707,14 @@ else
   endif
 endif
 
+# Setting environment variables is not supported in Java grades.
+ifeq "$(filter java%,$(GRADE))" ""
+	SETENV_PROGS = \
+		setenv
+else
+	SETENV_PROGS =
+endif
+
 # We currently test only a limited selection in grade java on this directory.
 PROGS = \
 	$(ORDINARY_PROGS) \
@@ -727,7 +735,8 @@ PROGS = \
 	$(TRACE_GOAL_ENV_PROGS) \
 	$(CTGC_PROGS) \
 	$(BIG_DATA_PROGS) \
-	$(CONC_PROGS)
+	$(CONC_PROGS) \
+	$(SETENV_PROGS)
 
 #-----------------------------------------------------------------------------#
 
diff --git a/tests/hard_coded/setenv.exp b/tests/hard_coded/setenv.exp
new file mode 100644
index 0000000..154f429
--- /dev/null
+++ b/tests/hard_coded/setenv.exp
@@ -0,0 +1,3 @@
+Use mem: ok
+Use mem: ok
+Got value: bar
diff --git a/tests/hard_coded/setenv.m b/tests/hard_coded/setenv.m
new file mode 100644
index 0000000..95f0132
--- /dev/null
+++ b/tests/hard_coded/setenv.m
@@ -0,0 +1,44 @@
+:- module setenv.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module gc.
+:- import_module int.
+:- import_module list.
+:- import_module maybe.
+:- import_module string.
+
+main(!IO) :-
+    io.set_environment_var("foo", "bar", !IO),
+
+    % Earlier versions of the Mercury library relied on putenv, which
+    % on many platforms requires that we don't garbage collect the
+    % string we pass it. This code tests we can handle that.
+    use_mem(1000000, !IO),
+    gc.garbage_collect(!IO),
+    use_mem(1000000, !IO),
+
+    io.get_environment_var("foo", Res, !IO),
+    (
+        Res = yes(Value),
+        io.write_string("Got value: " ++ Value ++ "\n", !IO)
+    ;
+        Res = no,
+        io.write_string("Failure!\n", !IO)
+    ).
+
+:- pred use_mem(int::in, io::di, io::uo) is det.
+
+use_mem(N, !IO) :-
+    io.write_string("Use mem: ", !IO),
+    ( if length(1 `..` N) = N then
+        io.write_string("ok\n", !IO)
+    else
+        io.write_string("hmm\n", !IO)
+    ).
+