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

extra error checks for call-with-temp-dir

Browse source
This commit is contained in:
Alex Shinn 2015-04-23 18:31:22 +09:00
parent 28011727e4
commit ef86d2ff65
1 changed files with 10 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
lib/chibi/temp-file.scm
View file

@ -26,10 +26,10 @@
res))))))))) res)))))))))
(define (call-with-temp-dir template proc) (define (call-with-temp-dir template proc)
(let ((base (string-append (let* ((pid (current-process-id))
"/tmp/" template (base (string-append
"-" (number->string (current-process-id)) "-" "/tmp/" template "-" (number->string pid) "-"
(number->string (exact (round (current-second)))) "-"))) (number->string (exact (round (current-second)))) "-")))
(let lp ((i 0)) (let lp ((i 0))
(let ((path (string-append base (number->string i)))) (let ((path (string-append base (number->string i))))
(cond (cond
@ -39,5 +39,9 @@
(lp (+ i 1))) (lp (+ i 1)))
((create-directory path #o700) ((create-directory path #o700)
(let ((res (proc path))) (let ((res (proc path)))
(delete-file-hierarchy path) ;; sanity check for host threading issues and broken forks
res))))))) (if (equal? pid (current-process-id))
(delete-file-hierarchy path))
res))
(else
(error "failed to create directory" path)))))))