Here an updated version of a recently submitted patch, taking into account some test results we discussed on the #chicken IRC channel.
The test for temporary files needs to unset TMP and TEMP or it will not work as intended. I also changed the final fallback for Windows (not Cygwin) to use "%USERPROFILE%\AppData\Local\Temp", as suggested by "jjhoo". felix
From 3670600da5c6ddc1c83e173256801b314b84a5d7 Mon Sep 17 00:00:00 2001 From: felix <fe...@call-with-current-continuation.org> Date: Wed, 12 Jun 2024 16:29:41 +0200 Subject: [PATCH] Use proper win32 API to set environment variable instead of falling back on putenv --- file.scm | 7 ++++++- library.scm | 8 +++++++- tests/test-create-temporary-file.scm | 2 ++ 3 files changed, 15 insertions(+), 2 deletions(-) diff --git a/file.scm b/file.scm index f8f45bd9..3448ec65 100644 --- a/file.scm +++ b/file.scm @@ -309,7 +309,12 @@ EOF (or (get-environment-variable "TMPDIR") (get-environment-variable "TEMP") (get-environment-variable "TMP") - "/tmp")) + (if ##sys#windows-platform + (let ((up (get-environment-variable "USERPROFILE"))) + (if up + (string-append up "/AppData/Local/Temp") + ".")) + "/tmp"))) (set! create-temporary-file (lambda (#!optional (ext "tmp")) (##sys#check-string ext 'create-temporary-file) diff --git a/library.scm b/library.scm index 4a8a2d33..ed0f53b7 100644 --- a/library.scm +++ b/library.scm @@ -6014,9 +6014,14 @@ extern char **environ; #else # if defined(_WIN32) && !defined(__CYGWIN__) # define C_unsetenv(s) C_setenv(s, C_SCHEME_FALSE) +static C_word C_fcall C_setenv(C_word x, C_word y) { + char *sx = C_c_string(x); + if(y == C_SCHEME_FALSE) SetEnvironmentVariable(sx, NULL); + else SetEnvironmentVariable(sx, C_c_string(y)); + return C_fix(0); +} # else # define C_unsetenv(s) C_fix(putenv((char *)C_data_pointer(s))) -# endif static C_word C_fcall C_setenv(C_word x, C_word y) { char *sx = C_c_string(x), *sy = (y == C_SCHEME_FALSE ? "" : C_c_string(y)); @@ -6031,6 +6036,7 @@ static C_word C_fcall C_setenv(C_word x, C_word y) { return(C_fix(putenv(buf))); } } +# endif #endif <# diff --git a/tests/test-create-temporary-file.scm b/tests/test-create-temporary-file.scm index 67e664c3..c2237f68 100644 --- a/tests/test-create-temporary-file.scm +++ b/tests/test-create-temporary-file.scm @@ -20,6 +20,8 @@ ;; ;; Here the use of "" as value of TMPDIR is because ;; (pathname-directory (make-pathname "" filename)) => #f +(unset-environment-variable! "TMP") ; unset to ensure TMPDIR is used +(unset-environment-variable! "TEMP") (with-environment-variable "TMPDIR" "" (lambda () (let ((tmp (create-temporary-file))) -- 2.42.0