aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-03-08 00:17:52 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2022-03-08 00:17:52 +0100
commit7931a1bcaccfc50ec0e1358b0fc80518b3c00a29 (patch)
tree2f31fb99d41f7045876769e72383f1b4caad8733
parentAdd test for begin1 and set! interaction. (diff)
downloadcalp-7931a1bcaccfc50ec0e1358b0fc80518b3c00a29.tar.gz
calp-7931a1bcaccfc50ec0e1358b0fc80518b3c00a29.tar.xz
Respecificy return value of with-atomic-output-to-file.
-rw-r--r--module/hnh/util/io.scm28
1 files changed, 15 insertions, 13 deletions
diff --git a/module/hnh/util/io.scm b/module/hnh/util/io.scm
index 161e09a0..3a595b67 100644
--- a/module/hnh/util/io.scm
+++ b/module/hnh/util/io.scm
@@ -1,4 +1,5 @@
(define-module (hnh util io)
+ :use-module ((hnh util) :select (begin1))
:use-module ((ice-9 rdelim) :select (read-line)))
(define-public (open-input-port str)
@@ -13,18 +14,18 @@
(define-public (read-lines port)
- (with-input-from-port port
- (lambda ()
- (let loop ((line (read-line)))
- (if (eof-object? line)
- '() (cons line (loop (read-line))))))))
+ (let ((line (read-line port)))
+ (if (eof-object? line)
+ '() (cons line (read-lines port)))))
;; Same functionality as the regular @var{with-output-to-file}, but
;; with the difference that either everything is written, or nothing
;; is written, and if anything is written it's all written atomicaly at
;; once (the original file will never contain an intermidiate state).
;; Does NOT handle race conditions between threads.
-;; Return #f on failure, something truthy otherwise
+;;
+;; propagates the return value of @var{thunk} upon successfully writing
+;; the file, and @code{#f} otherwise.
(define-public (with-atomic-output-to-file filename thunk)
;; copy to enusre writable string
(define tmpfile (string-copy (string-append
@@ -36,13 +37,14 @@
(dynamic-wind
(lambda () (set! port (mkstemp! tmpfile)))
(lambda ()
- (with-output-to-port port thunk)
- ;; Closing a port forces a write, due to buffering
- ;; some of the errors that logically would come
- ;; from write calls are first raised here. But since
- ;; crashing is acceptable here, that's fine.
- (close-port port)
- (rename-file tmpfile filename))
+ (begin1
+ (with-output-to-port port thunk)
+ ;; Closing a port forces a write, due to buffering
+ ;; some of the errors that logically would come
+ ;; from write calls are first raised here. But since
+ ;; crashing is acceptable here, that's fine.
+ (close-port port)
+ (rename-file tmpfile filename)))
(lambda ()
(when (access? tmpfile F_OK)
;; I'm a bit unclear on how to trash our write buffer.