Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

(chibi filesystem): Stub out several features on Win32

Browse source 
- Win32 does not support symbolic links generally (NTFS does support it
  but it is not available for non-root users until Win10)
- Win32 does not have block size on stat() API
This commit is contained in:
okuoku 2017-12-14 21:34:15 +09:00
parent 3ea5b51c6c
commit 9e773f3daf
1 changed files with 23 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
lib/chibi/filesystem.scm
View file

@ -123,8 +123,13 @@
(define (file-group x) (stat-gid (if (stat? x) x (file-status x)))) (define (file-group x) (stat-gid (if (stat? x) x (file-status x))))
(define (file-represented-device x) (stat-rdev (if (stat? x) x (file-status x)))) (define (file-represented-device x) (stat-rdev (if (stat? x) x (file-status x))))
(define (file-size x) (stat-size (if (stat? x) x (file-status x)))) (define (file-size x) (stat-size (if (stat? x) x (file-status x))))
(cond-expand
(windows
(define (file-block-size x) 1)
(define (file-num-blocks x) (file-size x)))
(else
(define (file-block-size x) (stat-blksize (if (stat? x) x (file-status x)))) (define (file-block-size x) (stat-blksize (if (stat? x) x (file-status x))))
(define (file-num-blocks x) (stat-blocks (if (stat? x) x (file-status x)))) (define (file-num-blocks x) (stat-blocks (if (stat? x) x (file-status x))))))
(define (file-access-time x) (stat-atime (if (stat? x) x (file-status x)))) (define (file-access-time x) (stat-atime (if (stat? x) x (file-status x))))
(define (file-modification-time x) (stat-mtime (if (stat? x) x (file-status x)))) (define (file-modification-time x) (stat-mtime (if (stat? x) x (file-status x))))
(define (file-modification-time/safe x) (define (file-modification-time/safe x)
@ -149,9 +154,13 @@
(define (file-character? x) (file-test-mode S_ISCHR x)) (define (file-character? x) (file-test-mode S_ISCHR x))
(define (file-block? x) (file-test-mode S_ISBLK x)) (define (file-block? x) (file-test-mode S_ISBLK x))
(define (file-fifo? x) (file-test-mode S_ISFIFO x)) (define (file-fifo? x) (file-test-mode S_ISFIFO x))
(cond-expand
(windows
(define (file-link? x) #f))
(else
(define (file-link? x) (define (file-link? x)
(let ((st (if (stat? x) x (file-link-status x)))) (let ((st (if (stat? x) x (file-link-status x))))
(and st (S_ISLNK (stat-mode st))))) (and st (S_ISLNK (stat-mode st)))))))
(define (file-socket? x) (file-test-mode S_ISSOCK x)) (define (file-socket? x) (file-test-mode S_ISSOCK x))
(define (file-exists? x) (and (if (stat? x) #t (file-status x)) #t)) (define (file-exists? x) (and (if (stat? x) #t (file-status x)) #t))
@ -180,8 +189,12 @@
;;> Returns the path the symbolic link \var{file} points to, or ;;> Returns the path the symbolic link \var{file} points to, or
;;> \scheme{#f} on error. ;;> \scheme{#f} on error.
(cond-expand
(windows
(define (read-link file) #f))
(else
(define (read-link file) (define (read-link file)
(let* ((buf (make-string 512)) (let* ((buf (make-string 512))
(res (readlink file buf 512))) (res (readlink file buf 512)))
(and (positive? res) (and (positive? res)
(substring buf 0 res)))) (substring buf 0 res))))))