From: Henry M. Wu <edu/mit/csail/zurich/mhwu>
Date: Sun, 31 May 1992 06:15:39 +0000 (+0000)
Subject: Added test-and-set (file-touch) for call-with-temporary-filename.
X-Git-Tag: 20090517-FFI~9308
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=aac68fe7d60de294e2168060e21d9b33aef636b8;p=mit-scheme.git

Added test-and-set (file-touch) for call-with-temporary-filename.
---

diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index 88c804f25..4372dad1e 100644
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dosprm.scm,v 1.7 1992/05/29 00:11:34 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dosprm.scm,v 1.8 1992/05/31 06:15:39 mhwu Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -85,20 +85,16 @@ MIT in each case. |#
 	      (let ((base-name (string-append dir "_scm_tmp.")))
 		(let unique-file ((ext 0))
 		  (let ((name (string-append base-name (number->string ext))))
-		    ;; Needs test-and-set here
-		    (if (file-exists? name)
+		    (if (or (file-exists? name) (not (file-touch name)))
 			(if (fix:> ext 999) ; don't get rediculous here
 			    (error "Cannot find unique temp file name"
 				   base-name)
 			    (unique-file (fix:+ ext 1)))
 			(dynamic-wind
-			 (lambda ()
-			   (close-output-port (open-output-file name)))
-			 (lambda ()
-			   (receiver name))
-			 (lambda ()
-			   (if (file-exists? name)
-			       (delete-file name))))))))
+			 (lambda () unspecific)
+			 (lambda () (receiver name))
+			 (lambda () (if (file-exists? name)
+					(delete-file name))))))))
 	      (find-eligible-directory (cdr eligible-directories)))))))