added setenv and unsetenv to (ikarus).

This commit is contained in:
Abdulaziz Ghuloum 2008-12-23 20:58:46 -05:00
parent 05180035f2
commit 4918b0e965
4 changed files with 36 additions and 7 deletions

View File

@ -18,7 +18,7 @@
(export (export
posix-fork fork waitpid system file-exists? delete-file posix-fork fork waitpid system file-exists? delete-file
nanosleep getenv env environ file-ctime file-mtime nanosleep getenv setenv unsetenv env environ file-ctime file-mtime
current-directory file-regular? file-directory? file-readable? current-directory file-regular? file-directory? file-readable?
file-writable? file-executable? file-size rename-file file-writable? file-executable? file-size rename-file
file-symbolic-link? make-symbolic-link directory-list file-symbolic-link? make-symbolic-link directory-list
@ -29,7 +29,7 @@
(rnrs bytevectors) (rnrs bytevectors)
(except (ikarus) (except (ikarus)
nanosleep posix-fork fork waitpid system file-exists? nanosleep posix-fork fork waitpid system file-exists?
delete-file getenv env environ file-ctime file-mtime delete-file getenv setenv unsetenv env environ file-ctime file-mtime
current-directory file-regular? file-directory? current-directory file-regular? file-directory?
file-readable? file-writable? file-executable? file-size file-readable? file-writable? file-executable? file-size
rename-file file-symbolic-link? make-symbolic-link rename-file file-symbolic-link? make-symbolic-link
@ -322,6 +322,28 @@
($getenv-str key) ($getenv-str key)
(die who "key is not a string" key))) (die who "key is not a string" key)))
(define ($setenv key val overwrite)
(foreign-call "ikrt_setenv"
(string->utf8 key) (string->utf8 val) overwrite))
(define setenv
(case-lambda
[(key val overwrite)
(define who 'setenv)
(if (string? key)
(if (string? val)
(unless ($setenv key val overwrite)
(error who "cannot setenv"))
(die who "invalid value" val))
(die who "invalid key" key))]
[(key val) (setenv key val #t)]))
(define (unsetenv key)
(define who 'unsetenv)
(if (string? key)
(foreign-call "ikrt_unsetenv" (string->utf8 key))
(die who "invalid key" key)))
(define env (define env
(let () (let ()
(define env (define env

View File

@ -1 +1 @@
1722 1723

View File

@ -1344,6 +1344,8 @@
[string-titlecase i r uc] [string-titlecase i r uc]
[string-upcase i r uc] [string-upcase i r uc]
[getenv i] [getenv i]
[setenv i]
[unsetenv i]
[nanosleep i] [nanosleep i]
[char-ready? ] [char-ready? ]
[load i] [load i]

View File

@ -944,10 +944,8 @@ ikrt_make_vector2(ikptr len, ikptr obj, ikpcb* pcb){
ikptr ikptr
ikrt_setenv(ikptr key, ikptr val, ikptr overwrite){ ikrt_setenv(ikptr key, ikptr val, ikptr overwrite){
fprintf(stderr, "setenv busted!\n"); int err = setenv((char*)(key+off_bytevector_data),
exit(-1); (char*)(val+off_bytevector_data),
int err = setenv((char*)(long)(key+off_bytevector_data),
(char*)(long)(val+off_bytevector_data),
overwrite!=false_object); overwrite!=false_object);
if(err){ if(err){
return false_object; return false_object;
@ -956,6 +954,13 @@ ikrt_setenv(ikptr key, ikptr val, ikptr overwrite){
} }
} }
ikptr
ikrt_unsetenv(ikptr key){
unsetenv((char*)(key+off_bytevector_data));
return void_object;
}
ikptr ikptr
ikrt_environ(ikpcb* pcb){ ikrt_environ(ikpcb* pcb){