[m-rev.] diff: have_set_environment_var/0, set_environment_var/5

[Mark Brown]

Hi,

Diff is attached.

Mark
-------------- next part --------------
commit 96e8000a9b00da1704c5f806c52abab1f2008c87
Author: Mark Brown <mark at mercurylang.org>
Date:   Mon Apr 18 22:18:25 2016 +1000

    Add io.set_environment_var/5 and have_set_environment_var/0.
    
    library/io.m:
    	Add io.set_environment_var/5, which returns an io.res rather
    	than throwing an exception on error.
    
    	Add have_set_environment_var/0 which succeeds if
    	io.set_environment_var/{4,5} are avilable on the current platform.
    
    NEWS:
    	Announce the addition.

diff --git a/NEWS b/NEWS
index da524b2..08eff33 100644
--- a/NEWS
+++ b/NEWS
@@ -129,6 +129,11 @@ Changes to the Mercury standard library:
 * We have added temp_directory/3, make_temp_directory/3 and
   make_temp_directory/5 predicates to the io module.
 
+* We have added a variant of io.set_environment_var that returns an io.res
+  value rather than throwing an exception. We have added the predicate
+  io.have_set_environment_var/0 that tests for the ability to set
+  environment variables on the current platform.
+
 * We have added a module for discrete interval encoding trees, which are a
   highly efficient set implementation for fat sets.  This module is a
   contribution from Yes Logic Pty. Ltd.
diff --git a/library/io.m b/library/io.m
index aa2d96b..e1d96a6 100644
--- a/library/io.m
+++ b/library/io.m
@@ -1295,13 +1295,25 @@
     io::di, io::uo) is det.
 
     % First argument is the name of the environment variable, second argument
-    % is the value to be assigned to that variable.
-    % Throws a software_error/1 exception if the system runs out of environment
-    % space or if the environment cannot be modified.
+    % is the value to be assigned to that variable. Res is 'ok' on success or
+    % 'error(ErrorCode)' if the system runs out of environment space or if
+    % the environment cannot be modified.
+    %
     % Note that the environment cannot be modified on Java.
     %
+:- pred set_environment_var(string::in, string::in, io.res::out,
+    io::di, io::uo) is det.
+
+    % Same as set_environment_var/5, but throws an exception if an error
+    % occurs.
+    %
 :- pred set_environment_var(string::in, string::in, io::di, io::uo) is det.
 
+    % Test if the set_environment_var/{4,5} predicates are available.  This
+    % is false for Java backends.
+    %
+:- pred have_set_environment_var is semidet.
+
 %---------------------------------------------------------------------------%
 %
 % File handling predicates.
@@ -5695,15 +5707,30 @@ io.get_environment_var(Var, OptValue, !IO) :-
     ),
     OptValue = OptValue0.
 
-:- pragma promise_pure(io.set_environment_var/4).
+:- pragma promise_pure(io.set_environment_var/5).
 
-io.set_environment_var(Var, Value, !IO) :-
-    ( if impure io.setenv(Var, Value) then
-        true
+io.set_environment_var(Var, Value, Res, !IO) :-
+    ( if io.have_set_environment_var then
+        ( if impure io.setenv(Var, Value) then
+            Res = ok
+        else
+            string.format("Could not set environment variable `%s'",
+                [s(Var)], Message),
+            Res = error(io_error(Message))
+        )
     else
-        string.format("Could not set environment variable `%s'",
-            [s(Var)], Message),
-        error(Message)
+        Message = "Cannot set environment variables on this platform",
+        Res = error(io_error(Message))
+    ).
+
+io.set_environment_var(Var, Value, IO0, IO) :-
+    io.set_environment_var(Var, Value, Res, IO0, IO1),
+    (
+        Res = ok,
+        IO = IO1
+    ;
+        Res = error(ErrorCode),
+        error(io.error_message(ErrorCode))
     ).
 
 %---------------------------------------------------------------------------%
@@ -10342,6 +10369,36 @@ command_line_argument(_, "") :-
 
 %---------------------------------------------------------------------------%
 
+:- pragma foreign_proc("C",
+    have_set_environment_var,
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    SUCCESS_INDICATOR = MR_TRUE;
+").
+
+:- pragma foreign_proc("Java",
+    have_set_environment_var,
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    SUCCESS_INDICATOR = false;
+").
+
+:- pragma foreign_proc("C#",
+    have_set_environment_var,
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    SUCCESS_INDICATOR = true;
+").
+
+:- pragma foreign_proc("Erlang",
+    have_set_environment_var,
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    SUCCESS_INDICATOR = true;
+").
+
+%---------------------------------------------------------------------------%
+
 make_temp(Name, !IO) :-
     get_temp_directory(Dir, !IO),
     make_temp(Dir, "mtmp", Name, !IO).