~ 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