From c1b7d6b0279779cf03dc2d79dcbd705c03978ea1 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Thu, 2 Jul 2026 07:02:55 +0300 Subject: [PATCH] Improve file-info --- srfi/170.scm | 71 ++++++++++++++++++++++++----------------------- srfi/170/test.scm | 2 +- 2 files changed, 38 insertions(+), 35 deletions(-) diff --git a/srfi/170.scm b/srfi/170.scm index a3568ff..433f6bf 100644 --- a/srfi/170.scm +++ b/srfi/170.scm @@ -167,12 +167,12 @@ (st_size int) (st_blksize int) (st_blocks int) - (st_atim-tv_sec long) - (st_atim-tv_nsec long) - (st_mtim-tv_sec long) - (st_mtim-tv_nsec long) - (st_ctim-tv_sec long) - (st_ctim-tv_nsec long))) + (st_atim.tv_sec long) + (st_atim.tv_nsec long) + (st_mtim.tv_sec long) + (st_mtim.tv_nsec long) + (st_ctim.tv_sec long) + (st_ctim.tv_nsec long))) ;;> The file-info procedure returns a file-info record containing useful ;;> 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 @@ -185,37 +185,40 @@ (stat-pointer (make-c-bytevector (c-type-size stat-struct))) (result (if follow? (c-stat fname-pointer stat-pointer) - (c-lstat fname-pointer stat-pointer))) - (error-message "file-info error") - (error-pointer (string->c-bytevector error-message))) + (c-lstat fname-pointer stat-pointer)))) (when (< result 0) - (c-perror error-pointer) + (let* ((error-message "file-info error") + (error-pointer (string->c-bytevector error-message))) + (c-perror error-pointer) + (c-bytevector-free fname-pointer) + (c-bytevector-free stat-pointer) + (c-bytevector-free error-pointer) + (error error-message fname/port))) + (let ((fi (make-file-info + (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_mode) + (c-bytevector-ref stat-pointer stat-struct 'st_nlink) + (c-bytevector-ref stat-pointer stat-struct 'st_uid) + (c-bytevector-ref stat-pointer stat-struct 'st_gid) + (c-bytevector-ref stat-pointer stat-struct 'st_rdev) + (c-bytevector-ref stat-pointer stat-struct 'st_size) + (c-bytevector-ref stat-pointer stat-struct 'st_blksize) + (c-bytevector-ref stat-pointer stat-struct 'st_blocks) + (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_nsec)) + (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_nsec)) + (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_nsec)) + fname/port + follow?))) (c-bytevector-free fname-pointer) (c-bytevector-free stat-pointer) - (c-bytevector-free error-pointer) - (error error-message fname/port)) - (make-file-info - (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_mode) - (c-bytevector-ref stat-pointer stat-struct 'st_nlink) - (c-bytevector-ref stat-pointer stat-struct 'st_uid) - (c-bytevector-ref stat-pointer stat-struct 'st_gid) - (c-bytevector-ref stat-pointer stat-struct 'st_rdev) - (c-bytevector-ref stat-pointer stat-struct 'st_size) - (c-bytevector-ref stat-pointer stat-struct 'st_blksize) - (c-bytevector-ref stat-pointer stat-struct 'st_blocks) - (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_nsec)) - (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_nsec)) - (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_nsec)) - fname/port - follow?))) + fi))) ;;> The permission-bits for create-directory default to #o775 but are masked ;;> by the current umask. (define create-directory diff --git a/srfi/170/test.scm b/srfi/170/test.scm index 49c055f..55121c7 100644 --- a/srfi/170/test.scm +++ b/srfi/170/test.scm @@ -13,7 +13,7 @@ (define fi (file-info "/tmp" #f)) (write fi) (newline) -(write (file-info-directory? fi)) +(write (file-info:mode fi)) (newline)