suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add `make-environment-variables'

Browse Source 
Swap order of argument for `environment-variables-get'
and `environment-variables-set!', so that the environment
variables come first --- which follows the usual order.
This change means that the parameter isn't used to get
the default environment variables, but that seems ok; the
convenient interface is `getenv' and `putenv'.

On Windows, case-normalized environment variable names.

Also, change the implementation to use an immutable hash
internally.
This commit is contained in:
Matthew Flatt 2013-04-10 10:25:10 -06:00
parent cfe9f447c8
commit 6ea9a2b3e3
13 changed files with 861 additions and 775 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/racket/private/misc.rkt
View File

@ -203,7 +203,8 @@
(define (getenv s)
(unless (string-environment-variable-name? s)
(raise-argument-error 'getenv "string-environment-variable-name?" s))
(let ([v (environment-variables-get (string->bytes/locale s (char->integer #\?)))])
(let ([v (environment-variables-get (current-environment-variables)
(string->bytes/locale s (char->integer #\?)))])
(and v
(bytes->string/locale v #\?))))
@ -213,9 +214,9 @@
(unless (string-no-nuls? t)
(raise-argument-error 'putenv "string-no-nuls?" 1 s t))
(and
(environment-variables-set! (string->bytes/locale s (char->integer #\?))
(environment-variables-set! (current-environment-variables)
(string->bytes/locale s (char->integer #\?))
(string->bytes/locale t (char->integer #\?))
(current-environment-variables)
(lambda () #f))
#t))

36
collects/scribblings/reference/envvars.scrbl
View File

@ -9,6 +9,12 @@ from byte strings to bytes strings. A Racket process's initial
environment variables: accesses or changes to the set read or change
operating-system environment variables for the Racket process.
Since Windows environment variables are case-insensitive, and
@tech{environment variable set}'s key byte strings on Windows are
case-folded. More precisely, key byte strings are coerced to a UTF-8
encoding of characters that are converted to lowercase via
@racket[string-locale-downcase].
The current @tech{environment variable set}, which is determined by
the @racket[current-environment-variables] parameter, is propagated to
a @tech{subprocess} when the @tech{subprocess} is created.
@ -24,8 +30,7 @@ set}, @racket[#f] otherwise.}
A @tech{parameter} that determines the @tech{environment variable set}
that is propagated to a @tech{subprocess} and that is used as the
default set for functions such as @racket[environment-variables-get] or
@racket[getenv].}
default set for @racket[getenv] and @racket[putenv].}
@defproc[(bytes-environment-variable-name? [v any/c]) boolean?]{
@ -37,9 +42,17 @@ contain no bytes with the value @racket[0] or @racket[61], where
environment variable name also must have a non-zero length.}
@defproc[(environment-variables-get [name bytes-environment-variable-name?]
[env environment-variables?
(current-environment-variables)])
@defproc[(make-environment-variables [name bytes-environment-variable-name?]
[val bytes-no-nuls?]
... ...)
environment-variables?]{
Creates a fresh @tech{environment variable set} that is initialized
with the given @racket[name] to @racket[val] mappings.}
@defproc[(environment-variables-get [env environment-variables?]
[name bytes-environment-variable-name?])
(or/c #f (and/c bytes-no-nuls? immutable?))]{
Returns the mapping for @racket[name] in @racket[env], returning
@ -47,14 +60,12 @@ Returns the mapping for @racket[name] in @racket[env], returning
Normally, @racket[name] should be a byte-string encoding of a string
using the default encoding of the current @tech{locale}. On Windows,
@racket[name] is coerced to a UTF-8 encoding if @racket[env] is the
initial @tech{environment variable set} of the Racket process.}
@racket[name] is coerced to a UTF-8 encoding and case-normalized.}
@defproc[(environment-variables-set! [name bytes-environment-variable-name?]
@defproc[(environment-variables-set! [env environment-variables?]
[name bytes-environment-variable-name?]
[maybe-bstr (or/c bytes-no-nuls? #f)]
[env environment-variables?
(current-environment-variables)]
[fail (-> any)
(lambda ()
(raise (make-exn:fail ....)))])
@ -68,8 +79,9 @@ for @racket[name] is removed.
Normally, @racket[name] and @racket[maybe-bstr] should be a
byte-string encoding of a string using the default encoding of the
current @tech{locale}. On Windows, @racket[name] and
@racket[maybe-bstr] are coerced to a UTF-8 encoding if @racket[env] is
current @tech{locale}. On Windows, @racket[name] is
coerced to a UTF-8 encoding and case-normalized, and
@racket[maybe-bstr] is coerced to a UTF-8 encoding if @racket[env] is
the initial @tech{environment variable set} of the Racket process.
On success, the result of @racket[environment-variables-set!] is

32
collects/tests/racket/file.rktl
View File

@ -1261,6 +1261,8 @@
(test #t environment-variables? (current-environment-variables))
(test #f environment-variables? 10)
(test #t environment-variables? (environment-variables-copy (current-environment-variables)))
(test #t environment-variables? (make-environment-variables))
(test #t environment-variables? (make-environment-variables #"A" #"1"))
(test #t list? (environment-variables-keys (current-environment-variables)))
(test #t andmap bytes? (environment-variables-keys (current-environment-variables)))
(test #t =
@ -1274,6 +1276,11 @@
(test #f string-environment-variable-name? "x\0")
(test (not (eq? 'windows (system-type))) string-environment-variable-name? "")
(test #"1" environment-variables-get (make-environment-variables #"a" #"1" #"b" #"two") #"a")
(test #"two" environment-variables-get (make-environment-variables #"a" #"1" #"b" #"two") #"b")
(test #f environment-variables-get (make-environment-variables #"a" #"1" #"b" #"two") #"c")
(test #f environment-variables-get (make-environment-variables) #"a")
(define (env-var-tests)
(define success-1? (putenv "APPLE" "AnApple"))
(define success-2? (putenv "BANANA" "AnotherApple"))
@ -1290,19 +1297,22 @@
(test "AnotherApple" getenv "BANANA")
(test #f getenv "AnUndefinedEnvironmentVariable")
(test #"AnApple" environment-variables-get #"APPLE")
(err/rt-test (environment-variables-get #"=AP=PLE="))
(test (void) environment-variables-set! #"APPLE" #"=x=")
(test #"=x=" environment-variables-get #"APPLE")
(test #"AnotherApple" environment-variables-get #"BANANA")
(test (void) environment-variables-set! #"BANANA" #f)
(test #f environment-variables-get #"BANANA")
(define env (current-environment-variables))
(test #"AnApple" environment-variables-get env #"APPLE")
(err/rt-test (environment-variables-get env #"=AP=PLE="))
(test (void) environment-variables-set! env #"APPLE" #"=x=")
(test #"=x=" environment-variables-get env #"APPLE")
(test #"AnotherApple" environment-variables-get env #"BANANA")
(test (void) environment-variables-set! env #"BANANA" #f)
(test #f environment-variables-get env #"BANANA")
(test #f getenv "BANANA")
(test #"APPLE" car (member #"APPLE" (environment-variables-keys
(current-environment-variables))))
(test #f member #"BANANA" (environment-variables-keys
(current-environment-variables))))
(let ([apple (if (eq? 'windows (system-type))
#"apple"
#"APPLE")])
(test apple car (member apple (environment-variables-keys env))))
(test #f member #"BANANA" (environment-variables-keys env))
(test #f member #"banana" (environment-variables-keys env)))
(parameterize ([current-environment-variables
(environment-variables-copy

2
collects/tests/racket/subprocess.rktl
View File

@ -470,7 +470,7 @@
[current-environment-variables
(environment-variables-copy
(current-environment-variables))])
(environment-variables-set! #"Hola" #"hi, there")
(environment-variables-set! (current-environment-variables) #"Hola" #"hi, there")
(system* self "-e" "(getenv \"Hola\")"))
(test "\"hi, there\"\n" get-output-string out))

3
doc/release-notes/racket/HISTORY.txt
View File

@ -1,3 +1,6 @@
Version 5.3.4.3
Added make-environment-variables
Version 5.3.4.2
Added current-environment-variables, environment-variables-get,
environment-variables-set!, environment-variables-keys,

6
src/get-libs.rkt
View File

@ -104,7 +104,8 @@
["libpangocairo-1.0-0.dll" 94625]
["libpangowin32-1.0-0.dll" 143647]
["libpangoft2-1.0-0.dll" 679322]]
(if (environment-variables-get #"PLT_WIN_GTK")
(if (environment-variables-get (current-environment-variables)
#"PLT_WIN_GTK")
'(["libatk-1.0-0.dll" 153763]
["libgtk-win32-2.0-0.dll" 4740156]
["libgdk-win32-2.0-0.dll" 827670]
@ -195,7 +196,8 @@
(define-values (path-size/show)
(lambda (path)
(let-values ([(sz) (path-size path)])
(if (environment-variables-get #"PLT_SHOW_PATH_SIZES")
(if (environment-variables-get (current-environment-variables)
#"PLT_SHOW_PATH_SIZES")
(printf "~s ~s\n" path sz)
(void))
sz)))

1311
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

2
src/racket/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1092
#define EXPECTED_PRIM_COUNT 1093
#define EXPECTED_UNSAFE_COUNT 100
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_EXTFL_COUNT 45

3
src/racket/src/schpriv.h
View File

@ -4000,8 +4000,7 @@ void scheme_unused_intptr(intptr_t);
intptr_t scheme_check_overflow(intptr_t n, intptr_t m, intptr_t a);
Scheme_Object *scheme_make_environment_variables(Scheme_Hash_Table *ht);
# define SCHEME_ENVVARS_TABLE(ev) ((Scheme_Hash_Table *)SCHEME_PTR_VAL(ev))
Scheme_Object *scheme_make_environment_variables(Scheme_Hash_Tree *ht);
void *scheme_environment_variables_to_block(Scheme_Object *env, int *_need_free);
/*========================================================================*/

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.3.4.2"
#define MZSCHEME_VERSION "5.3.4.3"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 4
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

6
src/racket/src/startup.inc
View File

@ -261,7 +261,8 @@
"(if(and(relative-path? program)"
"(let-values(((base name dir?)(split-path program)))"
"(eq? base 'relative)))"
" (let ((paths-str (environment-variables-get #\"PATH\"))"
"(let((paths-str(environment-variables-get(current-environment-variables)"
" #\"PATH\"))"
"(win-add(lambda(s)(if(eq?(system-type) 'windows) "
" (cons (bytes->path #\".\") s) "
" s))))"
@ -635,7 +636,8 @@
"(cons-if(lambda(f r)(if f(cons f r) r))))"
"(path-list-string->path-list"
"(if user-too?"
" (let ((c (environment-variables-get #\"PLTCOLLECTS\")))"
"(let((c(environment-variables-get(current-environment-variables)"
" #\"PLTCOLLECTS\")))"
"(if c"
"(bytes->string/locale c #\\?)"
" \"\"))"

6
src/racket/src/startup.rktl
View File

@ -316,7 +316,8 @@
(if (and (relative-path? program)
(let-values ([(base name dir?) (split-path program)])
(eq? base 'relative)))
(let ([paths-str (environment-variables-get #"PATH")]
(let ([paths-str (environment-variables-get (current-environment-variables)
#"PATH")]
[win-add (lambda (s) (if (eq? (system-type) 'windows)
(cons (bytes->path #".") s)
s))])
@ -731,7 +732,8 @@
[cons-if (lambda (f r) (if f (cons f r) r))])
(path-list-string->path-list
(if user-too?
(let ([c (environment-variables-get #"PLTCOLLECTS")])
(let ([c (environment-variables-get (current-environment-variables)
#"PLTCOLLECTS")])
(if c
(bytes->string/locale c #\?)
""))

218
src/racket/src/string.c
View File

@ -306,6 +306,7 @@ static Scheme_Object *sch_getenv(int argc, Scheme_Object *argv[]);
static Scheme_Object *sch_getenv_names(int argc, Scheme_Object *argv[]);
static Scheme_Object *sch_putenv(int argc, Scheme_Object *argv[]);
static Scheme_Object *env_copy(int argc, Scheme_Object *argv[]);
static Scheme_Object *env_make(int argc, Scheme_Object *argv[]);
static Scheme_Object *current_environment_variables(int argc, Scheme_Object *argv[]);
static Scheme_Object *system_type(int argc, Scheme_Object *argv[]);
static Scheme_Object *system_library_subpath(int argc, Scheme_Object *argv[]);
@ -870,13 +871,13 @@ scheme_init_string (Scheme_Env *env)
scheme_add_global_constant("environment-variables-get",
scheme_make_immed_prim(sch_getenv,
"environment-variables-get",
1, 2),
2, 2),
env);
scheme_add_global_constant("environment-variables-set!",
scheme_make_prim_w_arity(sch_putenv,
"environment-variables-set!",
2, 4),
3, 4),
env);
scheme_add_global_constant("environment-variables-keys",
@ -891,6 +892,12 @@ scheme_init_string (Scheme_Env *env)
1, 1),
env);
scheme_add_global_constant("make-environment-variables",
scheme_make_immed_prim(env_make,
"make-environment-variables",
0, -1),
env);
/* Don't make these folding, since they're platform-specific: */
scheme_add_global_constant("system-type",
@ -2093,7 +2100,9 @@ extern char **environ;
# define GET_ENVIRON_ARRAY environ
#endif
Scheme_Object *scheme_make_environment_variables(Scheme_Hash_Table *ht)
#define SCHEME_ENVVARS_TABLE(ev) ((Scheme_Hash_Tree *)SCHEME_PTR_VAL(ev))
Scheme_Object *scheme_make_environment_variables(Scheme_Hash_Tree *ht)
{
Scheme_Object *ev;
@ -2238,25 +2247,32 @@ int byte_string_ok_name(Scheme_Object *o)
return 1;
}
static Scheme_Object *normalize_env_case(Scheme_Object *bs)
{
#ifdef DOS_FILE_SYSTEM
bs = scheme_byte_string_to_char_string(bs);
bs = string_locale_downcase(1, &bs);
bs = scheme_char_string_to_byte_string(bs);
#endif
return bs;
}
static Scheme_Object *sch_getenv(int argc, Scheme_Object *argv[])
{
char *name;
char *value;
Scheme_Object *bs, *ev, *val;
Scheme_Hash_Table *ht;
Scheme_Hash_Tree *ht;
bs = argv[0];
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_environment_variables_type))
scheme_wrong_contract("environment-variables-get", "environment-variables?", 0, argc, argv);
bs = argv[1];
if (!SCHEME_BYTE_STRINGP(bs)
|| !byte_string_ok_name(bs))
scheme_wrong_contract("environment-variables-get", "bytes-environment-variable-name?", 0, argc, argv);
if ((argc > 1)
&& !SAME_TYPE(SCHEME_TYPE(argv[1]), scheme_environment_variables_type))
scheme_wrong_contract("environment-variables-get", "environment-variables?", 1, argc, argv);
scheme_wrong_contract("environment-variables-get", "bytes-environment-variable-name?", 1, argc, argv);
if (argc > 1)
ev = argv[1];
else
ev = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_ENV_VARS);
ev = argv[0];
ht = SCHEME_ENVVARS_TABLE(ev);
if (!ht) {
@ -2270,7 +2286,8 @@ static Scheme_Object *sch_getenv(int argc, Scheme_Object *argv[])
return value ? scheme_make_byte_string(value) : scheme_false;
} else {
val = scheme_hash_get_atomic(ht, bs);
bs = normalize_env_case(bs);
val = scheme_hash_tree_get(ht, bs);
return val ? val : scheme_false;
}
}
@ -2320,41 +2337,43 @@ static int sch_unix_putenv(const char *var, const char *val, const intptr_t varl
static Scheme_Object *sch_putenv(int argc, Scheme_Object *argv[])
{
Scheme_Object *varbs, *valbs, *ev;
Scheme_Hash_Table *ht;
Scheme_Hash_Tree *ht;
char *var;
char *val;
int rc = 0, errid = 0;
varbs = argv[0];
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_environment_variables_type))
scheme_wrong_contract("environment-variables-set!", "environment-variables?", 0, argc, argv);
varbs = argv[1];
if (!SCHEME_BYTE_STRINGP(varbs)
|| !byte_string_ok_name(varbs))
scheme_wrong_contract("environment-variables-set!", "bytes-environment-variable-name?", 0, argc, argv);
valbs = argv[1];
scheme_wrong_contract("environment-variables-set!", "bytes-environment-variable-name?", 1, argc, argv);
valbs = argv[2];
if (!SCHEME_FALSEP(valbs)
&& (!SCHEME_BYTE_STRINGP(valbs)
|| scheme_byte_string_has_null(valbs)))
scheme_wrong_contract("environment-variables-set!", "(or/c bytes-no-nuls? #f)", 1, argc, argv);
if ((argc > 2)
&& !SAME_TYPE(SCHEME_TYPE(argv[2]), scheme_environment_variables_type))
scheme_wrong_contract("environment-variables-set!", "environment-variables?", 1, argc, argv);
scheme_wrong_contract("environment-variables-set!", "(or/c bytes-no-nuls? #f)", 2, argc, argv);
if (argc > 3)
scheme_check_proc_arity("environment-variables-set!", 0, 3, argc, argv);
if (argc > 2)
ev = argv[2];
else
ev = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_ENV_VARS);
ev = argv[0];
ht = SCHEME_ENVVARS_TABLE(ev);
if (ht) {
varbs = normalize_env_case(varbs);
if (SCHEME_FALSEP(valbs)) {
scheme_hash_set_atomic(ht, varbs, NULL);
ht = scheme_hash_tree_set(ht, varbs, NULL);
} else {
varbs = byte_string_to_immutable(1, &varbs);
valbs = byte_string_to_immutable(1, &valbs);
scheme_hash_set_atomic(ht, varbs, valbs);
ht = scheme_hash_tree_set(ht, varbs, valbs);
}
SCHEME_PTR_VAL(ev) = (Scheme_Object *)ht;
return scheme_void;
} else {
var = SCHEME_BYTE_STR_VAL(varbs);
@ -2391,22 +2410,22 @@ static Scheme_Object *sch_putenv(int argc, Scheme_Object *argv[])
static Scheme_Object *env_copy(int argc, Scheme_Object *argv[])
{
Scheme_Hash_Table *ht;
Scheme_Hash_Tree *ht;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_environment_variables_type))
scheme_wrong_contract("environment-variables-copy", "environment-variables?", 0, argc, argv);
ht = SCHEME_ENVVARS_TABLE(argv[0]);
if (ht)
return scheme_make_environment_variables(scheme_clone_hash_table(ht));
return scheme_make_environment_variables(ht);
/* copy system environment variables into a hash table: */
ht = scheme_make_hash_table_equal();
ht = scheme_make_hash_tree(1);
#ifdef DOS_FILE_SYSTEM
{
char *p;
wchar_t *e;
GC_CAN_IGNORE wchar_t *e;
int i, start, j;
Scheme_Object *var, *val;
@ -2414,16 +2433,15 @@ static Scheme_Object *env_copy(int argc, Scheme_Object *argv[])
for (i = 0; e[i]; ) {
start = i;
while (e[i]) {
i++;
}
while (e[i]) { i++; }
p = NARROW_PATH(e XFORM_OK_PLUS start);
for (j = 0; p[j] && p[j] != '='; j++) {
}
if (p[j]) {
if (j && p[j]) {
var = scheme_make_immutable_sized_byte_string(p, j, 1);
val = scheme_make_immutable_sized_byte_string(p XFORM_OK_PLUS j + 1, -1, 1);
scheme_hash_set(ht, var, val);
var = normalize_env_case(var);
ht = scheme_hash_tree_set(ht, var, val);
}
i++;
}
@ -2445,7 +2463,7 @@ static Scheme_Object *env_copy(int argc, Scheme_Object *argv[])
if (p[j]) {
var = scheme_make_immutable_sized_byte_string(p, j, 1);
val = scheme_make_immutable_sized_byte_string(p XFORM_OK_PLUS j + 1, -1, 1);
scheme_hash_set(ht, var, val);
ht = scheme_hash_tree_set(ht, var, val);
}
}
}
@ -2454,10 +2472,48 @@ static Scheme_Object *env_copy(int argc, Scheme_Object *argv[])
return scheme_make_environment_variables(ht);
}
static Scheme_Object *env_make(int argc, Scheme_Object *argv[])
{
Scheme_Hash_Tree *ht;
Scheme_Object *varbs, *valbs;
int i;
ht = scheme_make_hash_tree(1);
for (i = 0; i < argc; i += 2) {
varbs = argv[i];
if (!SCHEME_BYTE_STRINGP(varbs)
|| !byte_string_ok_name(varbs))
scheme_wrong_contract("make-environment-variables", "bytes-environment-variable-name?", i, argc, argv);
if (i+1 >= argc) {
scheme_contract_error("make-environment-variables",
"key does not have a value (i.e., an odd number of arguments were provided)",
"key", 1, argv[i],
NULL);
return NULL;
}
valbs = argv[i+1];
if (!SCHEME_FALSEP(valbs)
&& (!SCHEME_BYTE_STRINGP(valbs)
|| scheme_byte_string_has_null(valbs)))
scheme_wrong_contract("make-environment-variables", "(or/c bytes-no-nuls? #f)", i+1, argc, argv);
varbs = normalize_env_case(varbs);
varbs = byte_string_to_immutable(1, &varbs);
valbs = byte_string_to_immutable(1, &valbs);
ht = scheme_hash_tree_set(ht, varbs, valbs);
}
return scheme_make_environment_variables(ht);
}
static Scheme_Object *sch_getenv_names(int argc, Scheme_Object *argv[])
{
Scheme_Object *ev, *r = scheme_null;
Scheme_Hash_Table *ht;
Scheme_Object *ev, *r = scheme_null, *key, *val;
Scheme_Hash_Tree *ht;
int i;
ev = argv[0];
@ -2470,10 +2526,9 @@ static Scheme_Object *sch_getenv_names(int argc, Scheme_Object *argv[])
ht = SCHEME_ENVVARS_TABLE(ev);
}
for (i = ht->size; i--; ) {
if (ht->vals[i]) {
r = scheme_make_pair(ht->keys[i], r);
}
for (i = scheme_hash_tree_next(ht, -1); i != -1; i = scheme_hash_tree_next(ht, i)) {
scheme_hash_tree_index(ht, i, &key, &val);
r = scheme_make_pair(key, r);
}
return r;
@ -2490,7 +2545,8 @@ static int wc_strlen(const wchar_t *ws)
void *scheme_environment_variables_to_block(Scheme_Object *ev, int *_need_free)
{
Scheme_Hash_Table *ht;
Scheme_Hash_Tree *ht;
Scheme_Object *key, *val;
ht = SCHEME_ENVVARS_TABLE(ev);
if (!ht) {
@ -2510,31 +2566,29 @@ void *scheme_environment_variables_to_block(Scheme_Object *ev, int *_need_free)
int len = 0, slen;
GC_CAN_IGNORE wchar_t *r, *s;
for (i = ht->size; i--; ) {
if (ht->vals[i]) {
len += wc_strlen(WIDE_PATH(SCHEME_BYTE_STR_VAL(ht->keys[i])));
len += wc_strlen(WIDE_PATH(SCHEME_BYTE_STR_VAL(ht->vals[i])));
len += 2;
}
for (i = scheme_hash_tree_next(ht, -1); i != -1; i = scheme_hash_tree_next(ht, i)) {
scheme_hash_tree_index(ht, i, &key, &val);
len += wc_strlen(WIDE_PATH(SCHEME_BYTE_STR_VAL(key)));
len += wc_strlen(WIDE_PATH(SCHEME_BYTE_STR_VAL(val)));
len += 2;
}
r = (wchar_t *)malloc((len + 1) * sizeof(wchar_t));
len = 0;
for (i = ht->size; i--; ) {
if (ht->vals[i]) {
s = WIDE_PATH(SCHEME_BYTE_STR_VAL(ht->keys[i]));
slen = wc_strlen(s);
memcpy(r XFORM_OK_PLUS len, s, slen * sizeof(wchar_t));
len += slen;
r[len++] = '=';
s = WIDE_PATH(SCHEME_BYTE_STR_VAL(ht->vals[i]));
slen = wc_strlen(s);
memcpy(r XFORM_OK_PLUS len, s, slen * sizeof(wchar_t));
len += slen;
r[len++] = 0;
}
for (i = scheme_hash_tree_next(ht, -1); i != -1; i = scheme_hash_tree_next(ht, i)) {
scheme_hash_tree_index(ht, i, &key, &val);
s = WIDE_PATH(SCHEME_BYTE_STR_VAL(key));
slen = wc_strlen(s);
memcpy(r XFORM_OK_PLUS len, s, slen * sizeof(wchar_t));
len += slen;
r[len++] = '=';
s = WIDE_PATH(SCHEME_BYTE_STR_VAL(val));
slen = wc_strlen(s);
memcpy(r XFORM_OK_PLUS len, s, slen * sizeof(wchar_t));
len += slen;
r[len++] = 0;
}
r[len] = 0;
@ -2545,29 +2599,29 @@ void *scheme_environment_variables_to_block(Scheme_Object *ev, int *_need_free)
GC_CAN_IGNORE char **r, *s;
intptr_t i, len = 0, slen, c;
for (i = ht->size; i--; ) {
if (ht->vals[i]) {
len += SCHEME_BYTE_STRLEN_VAL(ht->keys[i]);
len += SCHEME_BYTE_STRLEN_VAL(ht->vals[i]);
len += 2;
}
for (i = scheme_hash_tree_next(ht, -1); i != -1; i = scheme_hash_tree_next(ht, i)) {
scheme_hash_tree_index(ht, i, &key, &val);
len += SCHEME_BYTE_STRLEN_VAL(key);
len += SCHEME_BYTE_STRLEN_VAL(val);
len += 2;
}
r = (char **)malloc((ht->count+1) * sizeof(char*) + len);
s = (char *)(r + (ht->count+1));
for (i = ht->size, c = 0; i--; ) {
if (ht->vals[i]) {
r[c++] = s;
slen = SCHEME_BYTE_STRLEN_VAL(ht->keys[i]);
memcpy(s, SCHEME_BYTE_STR_VAL(ht->keys[i]), slen);
s[slen] = '=';
s = s XFORM_OK_PLUS (slen + 1);
slen = SCHEME_BYTE_STRLEN_VAL(ht->vals[i]);
memcpy(s, SCHEME_BYTE_STR_VAL(ht->vals[i]), slen);
s[slen] = 0;
s = s XFORM_OK_PLUS (slen + 1);
}
c = 0;
for (i = scheme_hash_tree_next(ht, -1); i != -1; i = scheme_hash_tree_next(ht, i)) {
scheme_hash_tree_index(ht, i, &key, &val);
r[c++] = s;
slen = SCHEME_BYTE_STRLEN_VAL(key);
memcpy(s, SCHEME_BYTE_STR_VAL(key), slen);
s[slen] = '=';
s = s XFORM_OK_PLUS (slen + 1);
slen = SCHEME_BYTE_STRLEN_VAL(val);
memcpy(s, SCHEME_BYTE_STR_VAL(val), slen);
s[slen] = 0;
s = s XFORM_OK_PLUS (slen + 1);
}
r[c] = NULL;
return r;
}