~ chicken-core (chicken-5) 4e3c25dd6dda42e6b6b6af592ee4a164c09e5738
commit 4e3c25dd6dda42e6b6b6af592ee4a164c09e5738 Author: felix <felix@call-with-current-continuation.org> AuthorDate: Tue Aug 24 14:28:57 2010 +0200 Commit: felix <felix@call-with-current-continuation.org> CommitDate: Tue Aug 24 14:28:57 2010 +0200 file-copy and file-move give proper error when used on directories (thanks to syn) diff --git a/files.scm b/files.scm index 20a8d1c6..591467e0 100644 --- a/files.scm +++ b/files.scm @@ -67,24 +67,27 @@ EOF (and (file-exists? file) (delete-file file)) ) ) ;;; file-copy and file-move : they do what you'd think. + (define (file-copy origfile newfile #!optional (clobber #f) (blocksize 1024)) (##sys#check-string origfile 'file-copy) (##sys#check-string newfile 'file-copy) (##sys#check-number blocksize 'file-copy) - (or (and (integer? blocksize) (> blocksize 0)) - (##sys#error (string-append - "invalid blocksize given: not a positive integer - " - (number->string blocksize)))) - (or (file-exists? origfile) - (##sys#error (string-append "origfile does not exist - " origfile))) + (unless (and (integer? blocksize) (> blocksize 0)) + (##sys#error + 'file-copy + "invalid blocksize given: not a positive integer" + blocksize)) (and (file-exists? newfile) (or clobber - (##sys#error (string-append - "newfile exists but clobber is false - " - newfile)))) + (##sys#error + 'file-copy + "newfile exists but clobber is false" + newfile))) + (when (directory-exists? origfile) + (##sys#error 'file-copy "can not copy directories" origfile)) (let* ((i (open-input-file origfile)) (o (open-output-file newfile)) - (s (make-string blocksize))) + (s (make-string blocksize))) (let loop ((d (read-string! blocksize s i)) (l 0)) (if (fx= 0 d) @@ -100,20 +103,22 @@ EOF (##sys#check-string origfile 'file-move) (##sys#check-string newfile 'file-move) (##sys#check-number blocksize 'file-move) - (or (and (integer? blocksize) (> blocksize 0)) - (##sys#error (string-append - "invalid blocksize given: not a positive integer - " - (number->string blocksize)))) - (or (file-exists? origfile) - (##sys#error (string-append "origfile does not exist - " origfile))) + (unless (and (integer? blocksize) (> blocksize 0)) + (##sys#error + 'file-move + "invalid blocksize given: not a positive integer" + blocksize)) + (when (directory-exists? origfile) + (##sys#error 'file-move "can not move directories" origfile)) (and (file-exists? newfile) (or clobber - (##sys#error (string-append - "newfile exists but clobber is false - " - newfile)))) + (##sys#error + 'file-move + "newfile exists but clobber is false" + newfile))) (let* ((i (open-input-file origfile)) (o (open-output-file newfile)) - (s (make-string blocksize))) + (s (make-string blocksize))) (let loop ((d (read-string! blocksize s i)) (l 0)) (if (fx= 0 d)Trap