From 4918b0e965f2017e44ca8becca791e5aeb2ee871 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Tue, 23 Dec 2008 20:58:46 -0500
Subject: [PATCH] added setenv and unsetenv to (ikarus).

---
 scheme/ikarus.posix.ss | 26 ++++++++++++++++++++++++--
 scheme/last-revision   |  2 +-
 scheme/makefile.ss     |  2 ++
 src/ikarus-runtime.c   | 13 +++++++++----
 4 files changed, 36 insertions(+), 7 deletions(-)

diff --git a/scheme/ikarus.posix.ss b/scheme/ikarus.posix.ss
index b86d4a7..7821ab4 100644
--- a/scheme/ikarus.posix.ss
+++ b/scheme/ikarus.posix.ss
@@ -18,7 +18,7 @@
 
   (export
     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?
     file-writable? file-executable? file-size rename-file
     file-symbolic-link? make-symbolic-link directory-list
@@ -29,7 +29,7 @@
     (rnrs bytevectors)
     (except (ikarus)
       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?
       file-readable? file-writable? file-executable? file-size
       rename-file file-symbolic-link? make-symbolic-link
@@ -322,6 +322,28 @@
         ($getenv-str 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
     (let ()
       (define env
diff --git a/scheme/last-revision b/scheme/last-revision
index ad0b314..9b5f360 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1722
+1723
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index b030910..68a343a 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -1344,6 +1344,8 @@
     [string-titlecase                            i r uc]
     [string-upcase                               i r uc]
     [getenv                                      i]
+    [setenv                                      i]
+    [unsetenv                                    i]
     [nanosleep                                   i]
     [char-ready?                                 ]
     [load                                        i]
diff --git a/src/ikarus-runtime.c b/src/ikarus-runtime.c
index e2a259d..ce0a633 100644
--- a/src/ikarus-runtime.c
+++ b/src/ikarus-runtime.c
@@ -944,10 +944,8 @@ ikrt_make_vector2(ikptr len, ikptr obj, ikpcb* pcb){
 
 ikptr 
 ikrt_setenv(ikptr key, ikptr val, ikptr overwrite){
-  fprintf(stderr, "setenv busted!\n");
-  exit(-1);
-  int err = setenv((char*)(long)(key+off_bytevector_data), 
-                   (char*)(long)(val+off_bytevector_data),
+  int err = setenv((char*)(key+off_bytevector_data), 
+                   (char*)(val+off_bytevector_data),
                    overwrite!=false_object);
   if(err){
     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 
 ikrt_environ(ikpcb* pcb){