~ chicken-core (master) 3eb71ac29efedc49288431de5f8016c9c538ef63
commit 3eb71ac29efedc49288431de5f8016c9c538ef63
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jan 2 17:53:37 2026 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri Jan 2 17:53:37 2026 +0100
make behaviour of "delete-file*" and "delete-file" consistent wrt to broken symlinks
(problem pointed out by Clark Brown)
diff --git a/NEWS b/NEWS
index 0bf35e8d..698fe2d2 100644
--- a/NEWS
+++ b/NEWS
@@ -82,6 +82,8 @@
- Added `expand1' to (chicken syntax) module for expanding a macro
only once, also added the ",x1" command to "csi" for this.
- Added the (chicken version) module.
+ - "delete-file*" and "delete-file" now behave consistently with
+ broken symlinks.
- Syntax expander:
- `syntax-rules' attempts to better support tail patterns with ellipses
diff --git a/file.scm b/file.scm
index f3e62d13..f6992f0a 100644
--- a/file.scm
+++ b/file.scm
@@ -100,16 +100,26 @@ static C_word C_foundfile(C_word e,C_word b,C_word l) {
# define C_closedir(h) (closedir((DIR *)C_block_item(h, 0)), C_SCHEME_UNDEFINED)
#endif
-static C_word C_u_i_symbolic_linkp(C_word path)
+static C_word C_u_i_lstat(C_word path)
{
#if !defined(_WIN32) || defined(__CYGWIN__)
struct stat buf;
if (lstat(C_c_string(path), &buf) == 0)
- return C_mk_bool(S_ISLNK(buf.st_mode));
+ return C_fix(buf.st_mode);
+#else
+ struct _stat buf;
+ if(_wstat(C_utf16(C_utf16(path, 0), &buf) == 0)
+ return C_SCHEME_TRUE;
#endif
return C_SCHEME_FALSE;
}
+#if !defined(_WIN32) || defined(__CYGWIN__)
+# define C_u_i_symbolic_linkp(m) C_mk_bool(S_ISLNK(C_unfix(m)))
+#else
+# define C_u_i_symbolic_linkp(m) C_SCHEME_FALSE
+#endif
+
EOF
))
@@ -204,8 +214,11 @@ EOF
(loop)
(cons file (loop)))))))))
-(define-inline (*symbolic-link? name loc)
- (##core#inline "C_u_i_symbolic_linkp" (##sys#make-c-string name loc)))
+(define-inline (*lstat name loc)
+ (##core#inline "C_u_i_lstat" (##sys#make-c-string name loc)))
+
+(define-inline (*symbolic-link? m)
+ (##core#inline "C_u_i_symbolic_linkp" m))
(define-inline (*create-directory loc name)
(unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name loc)))
@@ -239,7 +252,7 @@ EOF
follow-symlinks: #f)))
(for-each
(lambda (f)
- ((cond ((*symbolic-link? f 'delete-directory) delete-file)
+ ((cond ((*symbolic-link? (*lstat f 'delete-directory)) delete-file)
((directory-exists? f) rmdir)
(else delete-file))
f))
@@ -259,7 +272,8 @@ EOF
filename)
(define (delete-file* file)
- (and (file-exists? file) (delete-file file)))
+ (and (*lstat file 'delete-file*)
+ (delete-file file)))
(define (rename-file oldfile newfile #!optional (clobber #f))
(##sys#check-string oldfile 'rename-file)
@@ -431,7 +445,7 @@ EOF
(rest (##sys#slot fs 1)))
(cond ((directory-exists? f)
(cond ((member filename '("." "..")) (loop dir rest r))
- ((and (*symbolic-link? f 'find-files) (not follow-symlinks))
+ ((and (*symbolic-link? (*lstat f 'find-files)) (not follow-symlinks))
(loop dir rest (if (pproc f) (action f r) r)))
((lproc f)
(loop dir
Trap