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
