Add set_environment_variable and delete_environment_variable

CHANGELOG.md

@@ -1,5 +1,10 @@
 ## Unreleased
 
+Changes to the existing modules
+  - Change in module `stdlib_system`
+    - Added `set_environment_variable` and `delete_environment_variable`
+      [#1187](https://github.com/fortran-lang/stdlib/issues/1187)
+
 Changes to the existing build system
   - Fixed absolute paths in generated pkg-config file for external BLAS/LAPACK 
     [#1109](https://github.com/fortran-lang/stdlib/issues/1109)

doc/specs/stdlib_system.md

@@ -800,6 +800,90 @@ Subroutine
 
 ---
 
+## `set_environment_variable` - Sets an environment variable
+
+### Status
+
+Experimental
+
+### Description
+
+This subroutine creates an environment variable for the calling process, or changes the value of one that already exists.
+
+The environment variable is visible to this process and to any process it starts afterwards. It is not exported back to the parent shell; that is a property of the operating system rather than of this implementation.
+
+`overwrite` selects whether an existing variable is replaced, and defaults to `.true.`. Windows has no equivalent of the POSIX flag -- `_putenv_s` always replaces -- so the argument has no effect under the Windows environment.
+
+### Syntax
+
+`call [[stdlib_system(module):set_environment_variable(subroutine)]] (name, value [, overwrite] [, err])`
+
+### Class
+
+Subroutine
+
+### Arguments
+
+`name`: Shall be a character string holding the name of the variable. It must not be empty and must not contain `=`; both are rejected before the call reaches the operating system, which reports them only as `EINVAL`. It is an `intent(in)` argument.
+
+`value`: Shall be a character string holding the value of `name`. It is an `intent(in)` argument.
+
+`overwrite`(optional): Shall be a `logical` selecting whether an existing variable is replaced. Defaults to `.true.`. If the variable exists and `overwrite` is `.false.`, its value is left unchanged and no error is returned. Has no effect on Windows, where the value is always replaced. It is an `intent(in)` argument.
+
+`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `intent(out)` argument.
+
+### Return values
+
+`err` is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop.
+
+### Example
+
+```fortran
+{!example/system/example_environment_variable.f90!}
+```
+
+---
+
+## `delete_environment_variable` - Removes an environment variable
+
+### Status
+
+Experimental
+
+### Description
+
+This subroutine removes an environment variable from the calling process.
+
+Deleting a variable that is not set is not an error, which matches the behaviour of `unsetenv`.
+
+As with `set_environment_variable`, the name must not be empty and must not contain `=`.
+
+### Syntax
+
+`call [[stdlib_system(module):delete_environment_variable(subroutine)]] (name [, err])`
+
+### Class
+
+Subroutine
+
+### Arguments
+
+`name`: Shall be a character string holding the name of the variable. It is an `intent(in)` argument.
+
+`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `intent(out)` argument.
+
+### Return values
+
+`err` is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop.
+
+### Example
+
+```fortran
+{!example/system/example_environment_variable.f90!}
+```
+
+---
+
 ## `exists` - Checks if a path exists in the filesystem
 
 ### Status

example/system/CMakeLists.txt

@@ -18,6 +18,7 @@ ADD_EXAMPLE(path_dir_name)
 ADD_EXAMPLE(make_directory)
 ADD_EXAMPLE(remove_directory)
 ADD_EXAMPLE(cwd)
+ADD_EXAMPLE(environment_variable)
 ADD_EXAMPLE(exists)
 ADD_EXAMPLE(is_file)
 ADD_EXAMPLE(is_directory)

example/system/example_environment_variable.f90

@@ -0,0 +1,34 @@
+! Illustrate the usage of `set_environment_variable`, `delete_environment_variable`
+program example_environment_variable
+    use stdlib_system, only: set_environment_variable, delete_environment_variable
+    use stdlib_error, only: state_type
+    implicit none
+
+    type(state_type) :: err
+    character(len=32) :: value
+    integer :: length, stat
+
+    call set_environment_variable("STDLIB_EXAMPLE", "hello", err=err)
+    if (err%error()) then
+        print *, "Error setting the variable: "//err%print()
+        error stop 1
+    end if
+
+    call get_environment_variable("STDLIB_EXAMPLE", value, length, stat)
+    print *, "STDLIB_EXAMPLE is "//value(:length)
+
+    ! `overwrite` is `.true.` by default. Asking for `.false.` keeps whatever
+    ! value the variable already has, and is not an error.
+    call set_environment_variable("STDLIB_EXAMPLE", "goodbye", overwrite=.false., err=err)
+    call get_environment_variable("STDLIB_EXAMPLE", value, length, stat)
+    print *, "after a refused overwrite it is still "//value(:length)
+
+    call delete_environment_variable("STDLIB_EXAMPLE", err=err)
+    if (err%error()) then
+        print *, "Error deleting the variable: "//err%print()
+        error stop 1
+    end if
+
+    call get_environment_variable("STDLIB_EXAMPLE", value, length, stat)
+    print *, "after deleting it, the lookup status is", stat
+end program example_environment_variable

src/system/stdlib_system.F90

@@ -185,6 +185,37 @@ module stdlib_system
 !!
 public :: set_cwd
 
+!! version: experimental
+!!
+!! Sets an environment variable for the calling process
+!! ([Specification](../page/specs/stdlib_system.html#set_environment_variable))
+!!
+!! ### Summary
+!! Creates an environment variable, or changes the value of an existing one.
+!!
+!! ### Description
+!! The variable is visible to this process and to any process it starts
+!! afterwards. It is not written back to the parent shell, which is a property
+!! of the operating system rather than of this implementation.
+!!
+!! `overwrite` selects whether an existing variable is replaced, and defaults
+!! to `.true.`. It has no effect on Windows, whose `_putenv_s` always replaces.
+!!
+public :: set_environment_variable
+
+!! version: experimental
+!!
+!! Removes an environment variable from the calling process
+!! ([Specification](../page/specs/stdlib_system.html#delete_environment_variable))
+!!
+!! ### Summary
+!! Deletes an environment variable, if it is set.
+!!
+!! ### Description
+!! Removing a variable that is not set is not an error, which matches `unsetenv`.
+!!
+public :: delete_environment_variable
+
 !! version: experimental
 !!
 !! Deletes a specified file from the filesystem.
@@ -1193,6 +1224,96 @@ end function stdlib_set_cwd
     end if
 end subroutine set_cwd
 
+!> Sets an environment variable for the calling process.
+subroutine set_environment_variable(name, value, overwrite, err)
+    !> Name of the variable. Must not be empty or contain '='.
+    character(len=*), intent(in) :: name
+    !> Value to give it.
+    character(len=*), intent(in) :: value
+    !> Replace the variable if it already exists. Default `.true.`.
+    !> Ignored on Windows, where the underlying call always replaces.
+    logical, optional, intent(in) :: overwrite
+    !> Error handler
+    type(state_type), optional, intent(out) :: err
+
+    type(state_type) :: err0
+    integer :: code
+    integer :: overwrite_
+
+    interface
+        integer function stdlib_setenv(cname, cval, overwrite) bind(C, name='stdlib_setenv')
+            import c_char
+            character(kind=c_char), intent(in) :: cname(*)
+            character(kind=c_char), intent(in) :: cval(*)
+            integer, intent(in) :: overwrite
+        end function stdlib_setenv
+    end interface
+
+    ! Reject here rather than in C: `setenv` reports both of these as EINVAL,
+    ! which turns into "Invalid argument" and says nothing about which rule
+    ! was broken.
+    if (len_trim(name) == 0) then
+        err0 = FS_ERROR('the name of an environment variable cannot be empty')
+        call err0%handle(err)
+        return
+    end if
+
+    if (index(name, '=') > 0) then
+        err0 = FS_ERROR('the name of an environment variable cannot contain "=", got ',name)
+        call err0%handle(err)
+        return
+    end if
+
+    overwrite_ = 1
+    if (present(overwrite)) then
+        if (.not. overwrite) overwrite_ = 0
+    end if
+
+    code = stdlib_setenv(to_c_char(trim(name)), to_c_char(value), overwrite_)
+
+    if (code /= 0) then
+        err0 = FS_ERROR_CODE(code, c_get_strerror())
+        call err0%handle(err)
+    end if
+end subroutine set_environment_variable
+
+!> Removes an environment variable from the calling process.
+subroutine delete_environment_variable(name, err)
+    !> Name of the variable. Must not be empty or contain '='.
+    character(len=*), intent(in) :: name
+    !> Error handler
+    type(state_type), optional, intent(out) :: err
+
+    type(state_type) :: err0
+    integer :: code
+
+    interface
+        integer function stdlib_unsetenv(name) bind(C, name='stdlib_unsetenv')
+            import c_char
+            character(kind=c_char), intent(in) :: name(*)
+        end function stdlib_unsetenv
+    end interface
+
+    if (len_trim(name) == 0) then
+        err0 = FS_ERROR('the name of an environment variable cannot be empty')
+        call err0%handle(err)
+        return
+    end if
+
+    if (index(name, '=') > 0) then
+        err0 = FS_ERROR('the name of an environment variable cannot contain "=", got ',name)
+        call err0%handle(err)
+        return
+    end if
+
+    code = stdlib_unsetenv(to_c_char(name))
+
+    if (code /= 0) then
+        err0 = FS_ERROR_CODE(code, c_get_strerror())
+        call err0%handle(err)
+    end if
+end subroutine delete_environment_variable
+
 !> Returns the file path of the null device for the current operating system.
 !>
 !> Version: Helper function.

src/system/stdlib_system.c

@@ -178,6 +178,38 @@ int stdlib_exists(const char* path, int* stat){
     return type;
 }
 
+// Wrapper to the platform's call to set an environment variable.
+// Uses `setenv` on unix, `_putenv_s` on windows.
+// `overwrite` selects whether an existing variable is replaced. `_putenv_s`
+// always replaces, so the flag has no effect on windows.
+// Returns 0 if successful, otherwise returns the `errno`.
+int stdlib_setenv(const char* name, const char* value, const int* overwrite){
+    int code;
+#ifdef _WIN32
+    (void) overwrite;
+    code = _putenv_s(name, value);
+#else
+    code = setenv(name, value, *overwrite);
+#endif /* ifdef _WIN32 */
+
+    return (!code) ? 0 : errno;
+}
+
+// Wrapper to the platform's call to remove an environment variable.
+// Uses `unsetenv` on unix. Windows has no `unsetenv`; assigning an empty value
+// with `_putenv_s` is how the CRT removes a variable from the environment.
+// Returns 0 if successful, otherwise returns the `errno`.
+int stdlib_unsetenv(const char* name){
+    int code;
+#ifdef _WIN32
+    code = _putenv_s(name, "");
+#else
+    code = unsetenv(name);
+#endif /* ifdef _WIN32 */
+
+    return (!code) ? 0 : errno;
+}
+
 // `stat` and `_stat` follow symlinks automatically.
 // so no need for winapi functions.
 bool stdlib_is_file(const char* path) {