Merge branch 'environ_legacy' into 'develop'

Fix access to environ on Darwin

See merge request embeddable-common-lisp/ecl!301
This commit is contained in:
Marius Gerbershagen 2023-09-20 18:27:37 +00:00
commit c402748333
2 changed files with 76 additions and 77 deletions

View file

@ -844,83 +844,6 @@ si_argv(cl_object index)
FEerror("Illegal argument index: ~S.", 1, index);
}
cl_object
si_getenv(cl_object var)
{
const char *value;
/* Strings have to be null terminated base strings */
var = si_copy_to_simple_base_string(var);
value = getenv((char*)var->base_string.self);
@(return ((value == NULL)? ECL_NIL : ecl_make_simple_base_string(value,-1)));
}
#if defined(HAVE_SETENV) || defined(HAVE_PUTENV)
cl_object
si_setenv(cl_object var, cl_object value)
{
const cl_env_ptr the_env = ecl_process_env();
cl_fixnum ret_val;
/* Strings have to be null terminated base strings */
var = si_copy_to_simple_base_string(var);
if (value == ECL_NIL) {
#ifdef HAVE_SETENV
/* Remove the variable when setting to nil, so that
* (si:setenv "foo" nil), then (si:getenv "foo) returns
* the right thing. */
unsetenv((char*)var->base_string.self);
#else
#if defined(ECL_MS_WINDOWS_HOST)
si_setenv(var, cl_core.null_string);
#else
putenv((char*)var->base_string.self);
#endif
#endif
ret_val = 0;
} else {
#ifdef HAVE_SETENV
value = si_copy_to_simple_base_string(value);
ret_val = setenv((char*)var->base_string.self,
(char*)value->base_string.self, 1);
#else
value = cl_format(4, ECL_NIL, @"~A=~A", var,
value);
value = si_copy_to_simple_base_string(value);
putenv((char*)value->base_string.self);
#endif
}
if (ret_val == -1)
CEerror(ECL_T, "SI:SETENV failed: insufficient space in environment.",
1, ECL_NIL);
ecl_return1(the_env, value);
}
#endif
cl_object
si_environ(void)
{
cl_object output = ECL_NIL;
#ifdef HAVE_ENVIRON
char **p;
extern char **environ;
for (p = environ; *p; p++) {
output = CONS(ecl_make_constant_base_string(*p,-1), output);
}
output = cl_nreverse(output);
#else
# if defined(ECL_MS_WINDOWS_HOST)
LPTCH p;
for (p = GetEnvironmentStrings(); *p; ) {
output = CONS(ecl_make_constant_base_string(p,-1), output);
do { (void)0; } while (*(p++));
}
output = cl_nreverse(output);
# endif
#endif /* HAVE_ENVIRON */
@(return output);
}
cl_object
si_pointer(cl_object x)
{

View file

@ -57,6 +57,82 @@ si_system(cl_object cmd_string)
#endif
}
cl_object
si_getenv(cl_object var)
{
const char *value;
/* Strings have to be null terminated base strings */
var = si_copy_to_simple_base_string(var);
value = getenv((char*)var->base_string.self);
@(return ((value == NULL)? ECL_NIL : ecl_make_simple_base_string(value,-1)));
}
#if defined(HAVE_SETENV) || defined(HAVE_PUTENV)
cl_object
si_setenv(cl_object var, cl_object value)
{
const cl_env_ptr the_env = ecl_process_env();
cl_fixnum ret_val;
/* Strings have to be null terminated base strings */
var = si_copy_to_simple_base_string(var);
if (value == ECL_NIL) {
#ifdef HAVE_SETENV
/* Remove the variable when setting to nil, so that
* (si:setenv "foo" nil), then (si:getenv "foo) returns
* the right thing. */
unsetenv((char*)var->base_string.self);
#else
#if defined(ECL_MS_WINDOWS_HOST)
si_setenv(var, cl_core.null_string);
#else
putenv((char*)var->base_string.self);
#endif
#endif
ret_val = 0;
} else {
#ifdef HAVE_SETENV
value = si_copy_to_simple_base_string(value);
ret_val = setenv((char*)var->base_string.self,
(char*)value->base_string.self, 1);
#else
value = cl_format(4, ECL_NIL, @"~A=~A", var,
value);
value = si_copy_to_simple_base_string(value);
putenv((char*)value->base_string.self);
#endif
}
if (ret_val == -1)
CEerror(ECL_T, "SI:SETENV failed: insufficient space in environment.",
1, ECL_NIL);
ecl_return1(the_env, value);
}
#endif
cl_object
si_environ(void)
{
cl_object output = ECL_NIL;
#ifdef HAVE_ENVIRON
char **p;
for (p = environ; *p; p++) {
output = CONS(ecl_make_constant_base_string(*p,-1), output);
}
output = cl_nreverse(output);
#else
# if defined(ECL_MS_WINDOWS_HOST)
LPTCH p;
for (p = GetEnvironmentStrings(); *p; ) {
output = CONS(ecl_make_constant_base_string(p,-1), output);
do { (void)0; } while (*(p++));
}
output = cl_nreverse(output);
# endif
#endif /* HAVE_ENVIRON */
@(return output);
}
cl_object
si_getpid(void)
{