Retropikzel
/
foreign-c-srfis
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Improve file-info

This commit is contained in:
retropikzel 2026-07-02 07:02:55 +03:00
parent 32ab290142
commit c1b7d6b027
2 changed files with 38 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
srfi/170.scm
View File

@ -167,12 +167,12 @@
(st_size int) (st_size int)
(st_blksize int) (st_blksize int)
(st_blocks int) (st_blocks int)
(st_atim-tv_sec long) (st_atim.tv_sec long)
(st_atim-tv_nsec long) (st_atim.tv_nsec long)
(st_mtim-tv_sec long) (st_mtim.tv_sec long)
(st_mtim-tv_nsec long) (st_mtim.tv_nsec long)
(st_ctim-tv_sec long) (st_ctim.tv_sec long)
(st_ctim-tv_nsec long))) (st_ctim.tv_nsec long)))
;;> The file-info procedure returns a file-info record containing useful ;;> The file-info procedure returns a file-info record containing useful
;;> information about a file. If the follow? flag is true the procedure will ;;> information about a file. If the follow? flag is true the procedure will
;;> follow symlinks and report on the file to which they refer. If follow? is ;;> follow symlinks and report on the file to which they refer. If follow? is
@ -185,16 +185,16 @@
(stat-pointer (make-c-bytevector (c-type-size stat-struct))) (stat-pointer (make-c-bytevector (c-type-size stat-struct)))
(result (if follow? (result (if follow?
(c-stat fname-pointer stat-pointer) (c-stat fname-pointer stat-pointer)
(c-lstat fname-pointer stat-pointer))) (c-lstat fname-pointer stat-pointer))))
(error-message "file-info error")
(error-pointer (string->c-bytevector error-message)))
(when (< result 0) (when (< result 0)
(let* ((error-message "file-info error")
(error-pointer (string->c-bytevector error-message)))
(c-perror error-pointer) (c-perror error-pointer)
(c-bytevector-free fname-pointer) (c-bytevector-free fname-pointer)
(c-bytevector-free stat-pointer) (c-bytevector-free stat-pointer)
(c-bytevector-free error-pointer) (c-bytevector-free error-pointer)
(error error-message fname/port)) (error error-message fname/port)))
(make-file-info (let ((fi (make-file-info
(c-bytevector-ref stat-pointer stat-struct 'st_dev) (c-bytevector-ref stat-pointer stat-struct 'st_dev)
(c-bytevector-ref stat-pointer stat-struct 'st_ino) (c-bytevector-ref stat-pointer stat-struct 'st_ino)
(c-bytevector-ref stat-pointer stat-struct 'st_mode) (c-bytevector-ref stat-pointer stat-struct 'st_mode)
@ -206,16 +206,19 @@
(c-bytevector-ref stat-pointer stat-struct 'st_blksize) (c-bytevector-ref stat-pointer stat-struct 'st_blksize)
(c-bytevector-ref stat-pointer stat-struct 'st_blocks) (c-bytevector-ref stat-pointer stat-struct 'st_blocks)
(make-time time-utc (make-time time-utc
(c-bytevector-ref stat-pointer stat-struct 'st_atim-tv_sec) (c-bytevector-ref stat-pointer stat-struct 'st_atim.tv_sec)
(c-bytevector-ref stat-pointer stat-struct 'st_atim-tv_nsec)) (c-bytevector-ref stat-pointer stat-struct 'st_atim.tv_nsec))
(make-time time-utc (make-time time-utc
(c-bytevector-ref stat-pointer stat-struct 'st_mtim-tv_sec) (c-bytevector-ref stat-pointer stat-struct 'st_mtim.tv_sec)
(c-bytevector-ref stat-pointer stat-struct 'st_mtim-tv_nsec)) (c-bytevector-ref stat-pointer stat-struct 'st_mtim.tv_nsec))
(make-time time-utc (make-time time-utc
(c-bytevector-ref stat-pointer stat-struct 'st_ctim-tv_sec) (c-bytevector-ref stat-pointer stat-struct 'st_ctim.tv_sec)
(c-bytevector-ref stat-pointer stat-struct 'st_ctim-tv_nsec)) (c-bytevector-ref stat-pointer stat-struct 'st_ctim.tv_nsec))
fname/port fname/port
follow?))) follow?)))
(c-bytevector-free fname-pointer)
(c-bytevector-free stat-pointer)
fi)))
;;> The permission-bits for create-directory default to #o775 but are masked ;;> The permission-bits for create-directory default to #o775 but are masked
;;> by the current umask. ;;> by the current umask.
(define create-directory (define create-directory

2
srfi/170/test.scm
View File

@ -13,7 +13,7 @@
(define fi (file-info "/tmp" #f)) (define fi (file-info "/tmp" #f))
(write fi) (write fi)
(newline) (newline)
(write (file-info-directory? fi)) (write (file-info:mode fi))
(newline) (newline)