~ chicken-core (chicken-5) 17d9418adacdd03bdc9862d3e93932b4ea1be74c
commit 17d9418adacdd03bdc9862d3e93932b4ea1be74c
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Feb 17 07:38:43 2010 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed Feb 17 07:38:43 2010 +0100
file-deletion and rename returns destination filename
diff --git a/library.scm b/library.scm
index fe823d0b..1559b9d6 100644
--- a/library.scm
+++ b/library.scm
@@ -2106,7 +2106,8 @@ EOF
(##sys#update-errno)
(##sys#signal-hook
#:file-error 'delete-file
- (##sys#string-append "cannot delete file - " strerror) filename) ) )
+ (##sys#string-append "cannot delete file - " strerror) filename) )
+ filename)
#:delete) )
(define (rename-file old new)
@@ -2122,7 +2123,8 @@ EOF
(##sys#update-errno)
(##sys#signal-hook
#:file-error 'rename-file
- (##sys#string-append "cannot rename file - " strerror) old new) ) ) ) )
+ (##sys#string-append "cannot rename file - " strerror) old new) )
+ new)))
#:rename new) )
diff --git a/posixunix.scm b/posixunix.scm
index 5d3806d2..4ba55148 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -893,19 +893,24 @@ EOF
(when (and dir (not (*directory? 'create-directory dir)))
(loop (pathname-directory dir))
(*create-directory 'create-directory dir)) )
- (*create-directory 'create-directory name) ) ) ) ) ) )
+ (*create-directory 'create-directory name) ) )
+ name))))
(define change-directory
(lambda (name)
(##sys#check-string name 'change-directory)
- (unless (fx= 0 (##core#inline "C_chdir" (##sys#make-c-string (##sys#expand-home-path name))))
- (posix-error #:file-error 'change-directory "cannot change current directory" name) ) ) )
+ (let ((name (##sys#make-c-string (##sys#expand-home-path name))))
+ (unless (fx= 0 (##core#inline "C_chdir" name))
+ (posix-error #:file-error 'change-directory "cannot change current directory" name) )
+ name)))
(define delete-directory
(lambda (name)
(##sys#check-string name 'delete-directory)
- (unless (fx= 0 (##core#inline "C_rmdir" (##sys#make-c-string (##sys#expand-home-path name))))
- (posix-error #:file-error 'delete-directory "cannot delete directory" name) ) ) )
+ (let ((name (##sys#make-c-string (##sys#expand-home-path name))))
+ (unless (fx= 0 (##core#inline "C_rmdir" name))
+ (posix-error #:file-error 'delete-directory "cannot delete directory" name) )
+ name)))
(define directory
(let ([string-ref string-ref]
diff --git a/posixwin.scm b/posixwin.scm
index d30b7f8c..ea8bf0be 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -1190,7 +1190,7 @@ EOF
(define-inline (create-directory-helper-silent name)
(unless (create-directory-check name)
- (create-directory-helper name)))
+ (create-directory-helper name)))
(define-inline (create-directory-helper-parents name)
(let* ((l (string-split name "/\\"))
@@ -1207,21 +1207,27 @@ EOF
(let ((name (##sys#expand-home-path name)))
(if parents?
(create-directory-helper-parents name)
- (create-directory-helper name)))) )
+ (create-directory-helper name))
+ name)))
(define change-directory
(lambda (name)
(##sys#check-string name 'change-directory)
- (unless (fx= 0 (##core#inline "C_chdir" (##sys#make-c-string (##sys#expand-home-path name))))
- (##sys#update-errno)
- (##sys#signal-hook #:file-error 'change-directory "cannot change current directory" name) ) ) )
+ (let ((name (##sys#make-c-string (##sys#expand-home-path name))))
+ (unless (fx= 0 (##core#inline "C_chdir" name))
+ (##sys#update-errno)
+ (##sys#signal-hook
+ #:file-error 'change-directory "cannot change current directory" name) )
+ name)))
(define delete-directory
(lambda (name)
(##sys#check-string name 'delete-directory)
- (unless (fx= 0 (##core#inline "C_rmdir" (##sys#make-c-string (##sys#expand-home-path name))))
- (##sys#update-errno)
- (##sys#signal-hook #:file-error 'delete-directory "cannot delete directory" name) ) ) )
+ (let ((name (##sys#make-c-string (##sys#expand-home-path name))))
+ (unless (fx= 0 (##core#inline "C_rmdir" name))
+ (##sys#update-errno)
+ (##sys#signal-hook #:file-error 'delete-directory "cannot delete directory" name) )
+ name)))
(define directory
(let ([string-append string-append]
diff --git a/types.db b/types.db
index 5c05723f..567cfc8b 100644
--- a/types.db
+++ b/types.db
@@ -262,7 +262,7 @@
(current-read-table (procedure current-read-table () (struct read-table)))
(current-seconds (procedure current-seconds () number))
(define-reader-ctor (procedure define-reader-ctor (symbol procedure) undefined))
-(delete-file (procedure delete-file (string) undefined))
+(delete-file (procedure delete-file (string) string))
(enable-warnings (procedure enable-warnings (#!optional *) *))
(errno (procedure errno () fixnum))
(error (procedure error (#!rest) noreturn))
@@ -383,7 +383,7 @@
(put! (procedure put! (symbol symbol *) undefined))
(register-feature! (procedure register-feature! (#!rest symbol) undefined))
(remprop! (procedure remprop! (symbol symbol) undefined))
-(rename-file (procedure rename-file (string string) undefined))
+(rename-file (procedure rename-file (string string) string))
(repl (procedure repl () undefined))
(repl-prompt (procedure repl-prompt (#!optional procedure) procedure))
(repository-path (procedure repository-path (#!optional *) *))
@@ -510,9 +510,9 @@
;; files
-(delete-file* (procedure delete-file* (string) boolean))
-(file-copy (procedure file-copy (string string #!optional * fixnum) undefined))
-(file-move (procedure file-move (string string #!optional * fixnum) undefined))
+(delete-file* (procedure delete-file* (string) *))
+(file-copy (procedure file-copy (string string #!optional * fixnum) fixnum))
+(file-move (procedure file-move (string string #!optional * fixnum) fixnum))
(make-pathname (procedure make-pathname (* * #!optional string string) string))
(directory-null? (procedure directory-null? (string) boolean))
(make-absolute-pathname (procedure make-absolute-pathname (* * #!optional string string) string))
@@ -660,12 +660,12 @@
(call-with-input-pipe (procedure call-with-input-pipe (string (procedure (port) . *) #!optional symbol) . *))
(call-with-output-pipe (procedure call-with-output-pipe (string (procedure (port) . *) #!optional symbol) . *))
(canonical-path deprecated)
-(change-directory (procedure change-directory (string) undefined))
+(change-directory (procedure change-directory (string) string))
(change-file-mode (procedure change-file-mode (string fixnum) undefined))
(change-file-owner (procedure change-file-owner (string fixnum fixnum) undefined))
(close-input-pipe (procedure close-input-pipe (port) fixnum))
(close-output-pipe (procedure close-output-pipe (port) fixnum))
-(create-directory (procedure create-directory (string #!optional *) undefined))
+(create-directory (procedure create-directory (string #!optional *) string))
(create-fifo (procedure create-fifo (string #!optional fixnum) undefined))
(create-pipe (procedure create-pipe () fixnum fixnum))
(create-session (procedure create-session () fixnum))
@@ -680,7 +680,7 @@
(current-process-id (procedure current-process-id () fixnum))
(current-user-id (procedure current-user-id () fixnum))
(current-user-name (procedure current-user-name () string))
-(delete-directory (procedure delete-directory (string) undefined))
+(delete-directory (procedure delete-directory (string) string))
(directory (procedure directory (string #!optional *) list))
(directory? (procedure directory? (string) boolean))
(duplicate-fileno (procedure duplicate-fileno (fixnum #!optional fixnum) fixnum))
Trap