Make environment variable procedures match R7RS

This commit is contained in:
Lassi Kortela 2019-08-28 12:49:10 +03:00
parent 0ad800ea06
commit 40ba694ea6
3 changed files with 43 additions and 9 deletions

View File

@ -17,6 +17,8 @@
#include "scheme.h" #include "scheme.h"
extern char **environ;
size_t llength(value_t v) size_t llength(value_t v)
{ {
size_t n = 0; size_t n = 0;
@ -357,13 +359,35 @@ static value_t fl_path_exists(value_t *args, uint32_t nargs)
return os_path_exists(str) ? FL_T : FL_F; return os_path_exists(str) ? FL_T : FL_F;
} }
static value_t fl_os_getenv(value_t *args, uint32_t nargs) value_t builtin_get_environment_variables(value_t *args, uint32_t nargs)
{
struct accum acc = ACCUM_EMPTY;
char **pairs;
const char *pair;
const char *pivot;
value_t name, value;
(void)args;
argcount("get-environment-variables", nargs, 0);
for (pairs = environ; (pair = *pairs); pairs++) {
pivot = strchr(pair, '=');
if (!pivot) {
continue;
}
name = string_from_cstrn(pair, pivot - pair);
value = string_from_cstr(pivot + 1);
accum_pair(&acc, name, value);
}
return acc.list;
}
value_t builtin_get_environment_variable(value_t *args, uint32_t nargs)
{ {
char *name; char *name;
char *val; char *val;
argcount("os.getenv", nargs, 1); argcount("get-environment-variable", nargs, 1);
name = tostring(args[0], "os.getenv"); name = tostring(args[0], "get-environment-variable");
val = getenv(name); val = getenv(name);
if (val == NULL) if (val == NULL)
return FL_F; return FL_F;
@ -372,17 +396,17 @@ static value_t fl_os_getenv(value_t *args, uint32_t nargs)
return cvalue_static_cstring(val); return cvalue_static_cstring(val);
} }
static value_t fl_os_setenv(value_t *args, uint32_t nargs) value_t builtin_set_environment_variable(value_t *args, uint32_t nargs)
{ {
const char *name; const char *name;
const char *value; const char *value;
argcount("os.setenv", nargs, 2); argcount("set-environment-variable", nargs, 2);
name = tostring(args[0], "os.setenv"); name = tostring(args[0], "set-environment-variable");
if (args[1] == FL_F) { if (args[1] == FL_F) {
value = 0; value = 0;
} else { } else {
value = tostring(args[1], "os.setenv"); value = tostring(args[1], "set-environment-variable");
} }
os_setenv(name, value); os_setenv(name, value);
return FL_T; return FL_T;
@ -511,8 +535,7 @@ static struct builtinspec builtin_info[] = {
{ "path.cwd", fl_path_cwd }, { "path.cwd", fl_path_cwd },
{ "path.exists?", fl_path_exists }, { "path.exists?", fl_path_exists },
{ "os.getenv", fl_os_getenv }, { "os.getenv", builtin_get_environment_variable }, // TODO: remove
{ "os.setenv", fl_os_setenv },
{ "import-procedure", builtin_import }, { "import-procedure", builtin_import },

View File

@ -84,6 +84,13 @@ static struct builtin_procedure builtin_procedures[] = {
{ "read-directory", builtin_os_read_directory, SRFI_170 | UP_2019 }, { "read-directory", builtin_os_read_directory, SRFI_170 | UP_2019 },
{ "close-directory", builtin_os_close_directory, SRFI_170 | UP_2019 }, { "close-directory", builtin_os_close_directory, SRFI_170 | UP_2019 },
{ "get-environment-variables", builtin_get_environment_variables,
R7RS_PROCESS_CONTEXT | UP_2019 },
{ "get-environment-variable", builtin_get_environment_variable,
R7RS_PROCESS_CONTEXT | UP_2019 },
{ "set-environment-variable", builtin_set_environment_variable,
R7RS_PROCESS_CONTEXT | UP_2019 },
{ 0, 0, 0 }, { 0, 0, 0 },
}; };

View File

@ -996,6 +996,10 @@ value_t builtin_read_ini_file(value_t *args, uint32_t nargs);
value_t builtin_color_name_to_rgb24(value_t *args, uint32_t nargs); value_t builtin_color_name_to_rgb24(value_t *args, uint32_t nargs);
value_t builtin_get_environment_variables(value_t *args, uint32_t nargs);
value_t builtin_get_environment_variable(value_t *args, uint32_t nargs);
value_t builtin_set_environment_variable(value_t *args, uint32_t nargs);
//// #include "stringfuncs.h" //// #include "stringfuncs.h"
value_t fl_stringp(value_t *args, uint32_t nargs); value_t fl_stringp(value_t *args, uint32_t nargs);