~ chicken-core (chicken-5) b663e07c84bc011db7590f556b3cac02ce3e4308


commit b663e07c84bc011db7590f556b3cac02ce3e4308
Author:     Mario Domenech Goulart <mario.goulart@gmail.com>
AuthorDate: Sat Nov 9 12:32:46 2013 -0200
Commit:     Peter Bex <sjamaan@yves.more-magic.net>
CommitDate: Sat Nov 9 16:48:26 2013 +0100

    Fix unsetenv on Windows
    
    Environment variables were not really being unset on Windows.
    
    Assume the following code:
    
      (use posix)
    
      (setenv "FOO" "bar")
      (print "1 " (get-environment-variable "FOO"))
      (unsetenv "FOO")
      (print "2 " (get-environment-variable "FOO"))
    
    Before this patch, the output was:
    
      1 bar
      2 bar
    
    After this patch, the output is:
    
      1 bar
      2 #f
    
    as expected.
    
    This patch only affects Windows systems.
    
    Signed-off-by: Peter Bex <sjamaan@yves.more-magic.net>

diff --git a/NEWS b/NEWS
index 17a4f690..2f1e06d1 100644
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,7 @@
      use modules and forgot to require ports but use procedures from it.
   - Support has been added for the space-safe R7RS macro "delay-force".
   - Export file-type from the posix unit (thanks to Alan Post).
+  - unsetenv has been fixed on Windows
 
 - Platform support
   - CHICKEN can now be built on AIX (contributed by Erik Falor)
diff --git a/posixwin.scm b/posixwin.scm
index 753bd4b6..934cf815 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -1384,7 +1384,10 @@ EOF
 
 (define (unsetenv var)
   (##sys#check-string var 'unsetenv)
-  (##core#inline "C_putenv" (##sys#make-c-string var 'unsetenv))
+  ;; Windows does not support unsetenv, but it can be faked with setenv to ""
+  (##core#inline "C_setenv"
+                 (##sys#make-c-string var 'setenv)
+                 (##sys#make-c-string ""))
   (##core#undefined) )
 
 (define get-environment-variables
diff --git a/tests/posix-tests.scm b/tests/posix-tests.scm
index 6ee8993e..f2273974 100644
--- a/tests/posix-tests.scm
+++ b/tests/posix-tests.scm
@@ -50,3 +50,9 @@
   (delete-directory tmp-dir 'recursively)
   (assert (not (directory-exists? tmp-dot)))
   (assert (not (directory-exists? tmp-dir))))
+
+;; unsetenv
+(setenv "FOO" "bar")
+(assert (equal? (get-environment-variable "FOO") "bar"))
+(unsetenv "FOO")
+(assert (not (get-environment-variable "FOO")))
Trap