Commit ae8fbc16 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix lp#1239237 with-temporary-file must delete-file after close in case we don't keep the file.

Add a regression test.
More tweaks to the test and test suite.
parent 226001b8
......@@ -457,7 +457,7 @@ is bound, write a message and exit on an error. If
(null "1.0"))))))
(defun output-location (&rest sublocation)
(list* *asdf-directory* "build/fasls" :implementation sublocation))
(list* *asdf-directory* "build/fasls" :implementation-type sublocation))
(defun resolve-output (&rest sublocation)
(acall :resolve-location (apply 'output-location sublocation)))
......
......@@ -11,7 +11,10 @@
(:static-file "level2/static.file")
(:static-file "test-tmp.cl")))))
(DBG "Loading the system")
(asdf:load-system 'test-module-pathnames)
(DBG "Checking pathnames")
(flet ((pathname-foo (x)
(list (or (normalize-pathname-directory-component (pathname-directory x)) '(:relative))
(pathname-name x) (pathname-type x))))
......
......@@ -19,28 +19,20 @@
;; These are funky and non portable, omit from tests:
;; (make-pathname* :name "." :type nil :directory '(:absolute "tmp"))
;; (make-pathname* :name "." :type "" :directory '(:absolute "tmp"))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "" :ensure-directory t))
'(:relative nil nil nil)))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "" :ensure-directory nil))
'(:relative nil nil nil)))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/" :ensure-directory t))
'(:absolute nil nil nil)))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/" :ensure-directory nil))
'(:absolute nil nil nil)))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/aa/ba" :ensure-directory t))
'(:absolute ("aa" "ba") nil nil)))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/aa/ba" :ensure-directory nil))
'(:absolute ("aa") "ba" nil)))
(assert
(version-satisfies (asdf-version) (asdf-version)))
(assert
(version-satisfies (asdf-version) "3.0"))
(assert
(version-satisfies (asdf-version) "2.0"))
(assert
(version<= "2.0" (asdf-version)))
(assert
(not (version-satisfies (asdf-version) "666")))
(macrolet ((ts (x y)
`(assert-equal (multiple-value-list (split-unix-namestring-directory-components ,@x))
',y)))
(ts ("" :ensure-directory t) (:relative nil nil nil))
(ts ("" :ensure-directory nil) (:relative nil nil nil))
(ts ("/" :ensure-directory t) (:absolute nil nil nil))
(ts ("/" :ensure-directory nil) (:absolute nil nil nil))
(ts ("/aa/ba" :ensure-directory t) (:absolute ("aa" "ba") nil nil))
(ts ("/aa/ba" :ensure-directory nil) (:absolute ("aa") "ba" nil)))
(assert (version-satisfies (asdf-version) (asdf-version)))
(assert (version-satisfies (asdf-version) "3.0"))
(assert (version-satisfies (asdf-version) "2.0"))
(assert (version<= "2.0" (asdf-version)))
(assert (not (version-satisfies (asdf-version) "666")))
(assert-pathnames-equal
(split-native-pathnames-string (join-namestrings '("foo" "bar")))
'(#p"foo" #p"bar"))
......@@ -235,10 +227,17 @@
(defparameter acrlf (strcat "a" +crlf+))
(defparameter blf (strcat "b" +lf+))
(defparameter ccr (strcat "c" +cr+))
(assert-equal `("a" ,+crlf+) (multiple-value-list (stripln acrlf)))
(assert-equal `("b" ,+lf+) (multiple-value-list (stripln blf)))
(assert-equal `("c" ,+cr+) (multiple-value-list (stripln ccr)))
(assert-equal `(,acrlf ,+crlf+) (multiple-value-list (stripln (strcat acrlf +crlf+))))
(assert-equal `(,blf ,+cr+) (multiple-value-list (stripln (strcat blf +cr+))))
(assert-equal `("c" ,+crlf+) (multiple-value-list (stripln (strcat ccr +lf+))))
(assert-equal `(,(strcat acrlf "b") ,+lf+) (multiple-value-list (stripln (strcat acrlf blf))))
(macrolet ((ts (x y z)
`(progn
(assert-equal (list ,x ,y) (multiple-value-list (stripln ,z)))
(assert-equal (strcat ,x ,y) ,z))))
(ts "a" +crlf+ acrlf)
(ts "b" +lf+ blf)
(ts "c" +cr+ ccr)
(ts acrlf +crlf+ (strcat acrlf +crlf+))
(ts blf +cr+ (strcat blf +cr+))
(ts "c" +crlf+ (strcat ccr +lf+))
(ts (strcat acrlf "b") +lf+ (strcat acrlf blf)))
(with-temporary-file (:stream s :direction :io :element-type 'character :prefix "LEP")
(println "Hello, World" s))
......@@ -546,18 +546,17 @@ The file will be open with specified DIRECTION, ELEMENT-TYPE and EXTERNAL-FORMAT
;; TODO: on Unix, do something about umask
;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL
;; TODO: on Unix, use CFFI and mkstemp -- but UIOP is precisely meant to not depend on CFFI or on anything! Grrrr.
(with-open-file (stream pathname
:direction direction
:element-type element-type
#-gcl2.6 :external-format #-gcl2.6 external-format
:if-exists nil :if-does-not-exist :create)
(when stream
(return
(if keep
(funcall thunk stream pathname)
(unwind-protect
(funcall thunk stream pathname)
(ignore-errors (delete-file pathname)))))))))
(unwind-protect
(with-open-file (stream pathname
:direction direction
:element-type element-type
#-gcl2.6 :external-format #-gcl2.6 external-format
:if-exists nil :if-does-not-exist :create)
(if stream
(return (funcall thunk stream pathname))
(setf pathname nil)))
(when (and pathname (not keep))
(ignore-errors (delete-file pathname))))))
(defmacro with-temporary-file ((&key (stream (gensym "STREAM") streamp)
(pathname (gensym "PATHNAME") pathnamep)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment