~ chicken-core (chicken-5) d9d52f099a7424f5dc126c8cbd52a232633a1e7b
commit d9d52f099a7424f5dc126c8cbd52a232633a1e7b
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Feb 20 17:46:50 2018 +1300
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sat Feb 24 15:34:30 2018 +0100
Move `file-{read,write,execute}-access?' to chicken.file
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/file.scm b/file.scm
index 4e1e4a90..0dc721a9 100644
--- a/file.scm
+++ b/file.scm
@@ -41,6 +41,19 @@
(foreign-declare #<<EOF
#include <errno.h>
+#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m)))
+
+/* For Windows */
+#ifndef R_OK
+# define R_OK 2
+#endif
+#ifndef W_OK
+# define W_OK 4
+#endif
+#ifndef X_OK
+# define X_OK 2
+#endif
+
#define C_rmdir(str) C_fix(rmdir(C_c_string(str)))
#ifndef _WIN32
@@ -228,6 +241,25 @@ EOF
new)
+;;; Permissions:
+
+(define-foreign-variable _r_ok int "R_OK")
+(define-foreign-variable _w_ok int "W_OK")
+(define-foreign-variable _x_ok int "X_OK")
+
+(define (test-access filename acc loc)
+ (##sys#check-string filename loc)
+ (let ((r (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc)))
+ (or (fx= r 0)
+ (if (fx= (##sys#update-errno) (foreign-value "EACCES" int))
+ #f
+ (posix-error #:file-error loc "cannot access file" filename)))))
+
+(define (file-read-access? filename) (test-access filename _r_ok 'file-read-access?))
+(define (file-write-access? filename) (test-access filename _w_ok 'file-write-access?))
+(define (file-execute-access? filename) (test-access filename _x_ok 'file-execute-access?))
+
+
;;; Directories:
(define (directory #!optional (spec (current-directory)) show-dotfiles?)
diff --git a/posix-common.scm b/posix-common.scm
index 98ffe85c..d3f1c751 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -44,17 +44,6 @@ static C_TLS struct stat C_statbuf;
# define S_IFSOCK 0140000
#endif
-/* For Windows */
-#ifndef R_OK
-#define R_OK 2
-#endif
-#ifndef W_OK
-#define W_OK 4
-#endif
-#ifndef X_OK
-#define X_OK 2
-#endif
-
#define cpy_tmvec_to_tmstc08(ptm, v) \
((ptm)->tm_sec = C_unfix(C_block_item((v), 0)), \
(ptm)->tm_min = C_unfix(C_block_item((v), 1)), \
@@ -317,27 +306,6 @@ EOF
(define (directory? file)
(eq? 'directory (file-type file #f #f)))
-(define file-read-access?)
-(define file-write-access?)
-(define file-execute-access?)
-
-(define-foreign-variable _r_ok int "R_OK")
-(define-foreign-variable _w_ok int "W_OK")
-(define-foreign-variable _x_ok int "X_OK")
-
-(let ()
- (define (check filename acc loc)
- (##sys#check-string filename loc)
- (let ((r (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc)))
- (if (fx= r -1)
- (if (fx= (##sys#update-errno) _eacces)
- #f
- (posix-error #:file-error loc "cannot access file" filename))
- #t)))
- (set! file-read-access? (lambda (filename) (check filename _r_ok 'file-read-access?)))
- (set! file-write-access? (lambda (filename) (check filename _w_ok 'file-write-access?)))
- (set! file-execute-access? (lambda (filename) (check filename _x_ok 'file-execute-access?))) )
-
;;; File position access:
diff --git a/posix.scm b/posix.scm
index bc1ff275..0129dbd3 100644
--- a/posix.scm
+++ b/posix.scm
@@ -50,11 +50,11 @@
directory? duplicate-fileno fcntl/dupfd fcntl/getfd
fcntl/getfl fcntl/setfd fcntl/setfl fifo? fifo? file-access-time
file-change-time file-close file-control file-creation-mode
- file-execute-access? file-group file-link file-lock
+ file-group file-link file-lock
file-lock/blocking file-mkstemp file-modification-time file-open
- file-owner file-permissions file-position file-read file-read-access?
+ file-owner file-permissions file-position file-read
file-select file-size file-stat file-test-lock file-truncate
- file-type file-unlock file-write file-write-access? fileno/stderr
+ file-type file-unlock file-write fileno/stderr
fileno/stdin fileno/stdout
local-time->seconds local-timezone-abbreviation
open-input-file* open-input-pipe open-output-file* open-output-pipe
diff --git a/posixunix.scm b/posixunix.scm
index 124c6b6e..7607854d 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -134,7 +134,6 @@ static C_TLS struct stat C_statbuf;
#define C_truncate(f, n) C_fix(truncate((char *)C_data_pointer(f), C_num_to_int(n)))
#define C_ftruncate(f, n) C_fix(ftruncate(C_unfix(f), C_num_to_int(n)))
#define C_alarm alarm
-#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m)))
#define C_close(fd) C_fix(close(C_unfix(fd)))
#define C_umask(m) C_fix(umask(C_unfix(m)))
diff --git a/posixwin.scm b/posixwin.scm
index 31bcb9f3..d0dad8b8 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -111,7 +111,6 @@ static C_TLS TCHAR C_username[255 + 1] = "";
#define close_pipe(p) C_fix(_pclose(C_port_file(p)))
#define C_chmod(fn, m) C_fix(chmod(C_data_pointer(fn), C_unfix(m)))
-#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m)))
#define C_pipe(d, m) C_fix(_pipe(C_pipefds, PIPE_BUF, C_unfix(m)))
#define C_close(fd) C_fix(close(C_unfix(fd)))
diff --git a/types.db b/types.db
index e43b0322..eff9f9a4 100644
--- a/types.db
+++ b/types.db
@@ -1573,6 +1573,10 @@
(chicken.file#find-files (#(procedure #:enforce) chicken.file#find-files (string #!rest) list))
(chicken.file#glob (#(procedure #:clean #:enforce) chicken.file#glob (#!rest string) list))
(chicken.file#rename-file (#(procedure #:clean #:enforce) chicken.file#rename-file (string string) string))
+(chicken.file#file-read-access? (#(procedure #:clean #:enforce) chicken.file#file-read-access? (string) boolean))
+(chicken.file#file-write-access? (#(procedure #:clean #:enforce) chicken.file#file-write-access? (string) boolean))
+(chicken.file#file-execute-access? (#(procedure #:clean #:enforce) chicken.file#file-execute-access? (string) boolean))
+
;; pathname
@@ -1950,7 +1954,6 @@
(chicken.posix#file-close (#(procedure #:clean #:enforce) chicken.posix#file-close (fixnum) undefined))
(chicken.posix#file-control (#(procedure #:clean #:enforce) chicken.posix#file-control (fixnum fixnum #!optional fixnum) fixnum))
(chicken.posix#file-creation-mode (#(procedure #:clean #:enforce) chicken.posix#file-creation-mode (#!optional fixnum) fixnum))
-(chicken.posix#file-execute-access? (#(procedure #:clean #:enforce) chicken.posix#file-execute-access? (string) boolean))
(chicken.posix#file-link (#(procedure #:clean #:enforce) chicken.posix#file-link (string string) undefined))
(chicken.posix#file-lock (#(procedure #:clean #:enforce) chicken.posix#file-lock (port #!optional fixnum integer) (struct lock)))
(chicken.posix#file-lock/blocking (#(procedure #:clean #:enforce) chicken.posix#file-lock/blocking (port #!optional fixnum integer) (struct lock)))
@@ -1962,7 +1965,6 @@
(chicken.posix#file-permissions (#(procedure #:clean #:enforce) chicken.posix#file-permissions ((or string fixnum)) fixnum))
(chicken.posix#file-position (#(procedure #:clean #:enforce) chicken.posix#file-position ((or port fixnum)) integer))
(chicken.posix#file-read (#(procedure #:clean #:enforce) chicken.posix#file-read (fixnum fixnum #!optional *) list))
-(chicken.posix#file-read-access? (#(procedure #:clean #:enforce) chicken.posix#file-read-access? (string) boolean))
(chicken.posix#file-select (#(procedure #:clean #:enforce) chicken.posix#file-select ((or (list-of fixnum) fixnum false) (or (list-of fixnum) fixnum false) #!optional fixnum) * *))
(chicken.posix#file-size (#(procedure #:clean #:enforce) chicken.posix#file-size ((or string fixnum)) integer))
(chicken.posix#file-stat (#(procedure #:clean #:enforce) chicken.posix#file-stat ((or string fixnum) #!optional *) (vector-of integer)))
@@ -1971,7 +1973,6 @@
(chicken.posix#file-type (#(procedure #:clean #:enforce) chicken.posix#file-type ((or string fixnum) #!optional * *) symbol))
(chicken.posix#file-unlock (#(procedure #:clean #:enforce) chicken.posix#file-unlock ((struct lock)) undefined))
(chicken.posix#file-write (#(procedure #:clean #:enforce) chicken.posix#file-write (fixnum * #!optional fixnum) fixnum))
-(chicken.posix#file-write-access? (#(procedure #:clean #:enforce) chicken.posix#file-write-access? (string) boolean))
(chicken.posix#fileno/stderr fixnum)
(chicken.posix#fileno/stdin fixnum)
(chicken.posix#fileno/stdout fixnum)
Trap