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

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 ...@@ -457,7 +457,7 @@ is bound, write a message and exit on an error. If
(null "1.0")))))) (null "1.0"))))))
(defun output-location (&rest sublocation) (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) (defun resolve-output (&rest sublocation)
(acall :resolve-location (apply 'output-location sublocation))) (acall :resolve-location (apply 'output-location sublocation)))
......
...@@ -11,7 +11,10 @@ ...@@ -11,7 +11,10 @@
(:static-file "level2/static.file") (:static-file "level2/static.file")
(:static-file "test-tmp.cl"))))) (:static-file "test-tmp.cl")))))
(DBG "Loading the system")
(asdf:load-system 'test-module-pathnames) (asdf:load-system 'test-module-pathnames)
(DBG "Checking pathnames")
(flet ((pathname-foo (x) (flet ((pathname-foo (x)
(list (or (normalize-pathname-directory-component (pathname-directory x)) '(:relative)) (list (or (normalize-pathname-directory-component (pathname-directory x)) '(:relative))
(pathname-name x) (pathname-type x)))) (pathname-name x) (pathname-type x))))
......
...@@ -19,28 +19,20 @@ ...@@ -19,28 +19,20 @@
;; These are funky and non portable, omit from tests: ;; These are funky and non portable, omit from tests:
;; (make-pathname* :name "." :type nil :directory '(:absolute "tmp")) ;; (make-pathname* :name "." :type nil :directory '(:absolute "tmp"))
;; (make-pathname* :name "." :type "" :directory '(:absolute "tmp")) ;; (make-pathname* :name "." :type "" :directory '(:absolute "tmp"))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "" :ensure-directory t)) (macrolet ((ts (x y)
'(:relative nil nil nil))) `(assert-equal (multiple-value-list (split-unix-namestring-directory-components ,@x))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "" :ensure-directory nil)) ',y)))
'(:relative nil nil nil))) (ts ("" :ensure-directory t) (:relative nil nil nil))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/" :ensure-directory t)) (ts ("" :ensure-directory nil) (:relative nil nil nil))
'(:absolute nil nil nil))) (ts ("/" :ensure-directory t) (:absolute nil nil nil))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/" :ensure-directory nil)) (ts ("/" :ensure-directory nil) (:absolute nil nil nil))
'(:absolute nil nil nil))) (ts ("/aa/ba" :ensure-directory t) (:absolute ("aa" "ba") nil nil))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/aa/ba" :ensure-directory t)) (ts ("/aa/ba" :ensure-directory nil) (:absolute ("aa") "ba" nil)))
'(:absolute ("aa" "ba") nil nil))) (assert (version-satisfies (asdf-version) (asdf-version)))
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/aa/ba" :ensure-directory nil)) (assert (version-satisfies (asdf-version) "3.0"))
'(:absolute ("aa") "ba" nil))) (assert (version-satisfies (asdf-version) "2.0"))
(assert (assert (version<= "2.0" (asdf-version)))
(version-satisfies (asdf-version) (asdf-version))) (assert (not (version-satisfies (asdf-version) "666")))
(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 (assert-pathnames-equal
(split-native-pathnames-string (join-namestrings '("foo" "bar"))) (split-native-pathnames-string (join-namestrings '("foo" "bar")))
'(#p"foo" #p"bar")) '(#p"foo" #p"bar"))
...@@ -235,10 +227,17 @@ ...@@ -235,10 +227,17 @@
(defparameter acrlf (strcat "a" +crlf+)) (defparameter acrlf (strcat "a" +crlf+))
(defparameter blf (strcat "b" +lf+)) (defparameter blf (strcat "b" +lf+))
(defparameter ccr (strcat "c" +cr+)) (defparameter ccr (strcat "c" +cr+))
(assert-equal `("a" ,+crlf+) (multiple-value-list (stripln acrlf))) (macrolet ((ts (x y z)
(assert-equal `("b" ,+lf+) (multiple-value-list (stripln blf))) `(progn
(assert-equal `("c" ,+cr+) (multiple-value-list (stripln ccr))) (assert-equal (list ,x ,y) (multiple-value-list (stripln ,z)))
(assert-equal `(,acrlf ,+crlf+) (multiple-value-list (stripln (strcat acrlf +crlf+)))) (assert-equal (strcat ,x ,y) ,z))))
(assert-equal `(,blf ,+cr+) (multiple-value-list (stripln (strcat blf +cr+)))) (ts "a" +crlf+ acrlf)
(assert-equal `("c" ,+crlf+) (multiple-value-list (stripln (strcat ccr +lf+)))) (ts "b" +lf+ blf)
(assert-equal `(,(strcat acrlf "b") ,+lf+) (multiple-value-list (stripln (strcat acrlf 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 ...@@ -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, do something about umask
;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL ;; 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. ;; 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 (unwind-protect
:direction direction (with-open-file (stream pathname
:element-type element-type :direction direction
#-gcl2.6 :external-format #-gcl2.6 external-format :element-type element-type
:if-exists nil :if-does-not-exist :create) #-gcl2.6 :external-format #-gcl2.6 external-format
(when stream :if-exists nil :if-does-not-exist :create)
(return (if stream
(if keep (return (funcall thunk stream pathname))
(funcall thunk stream pathname) (setf pathname nil)))
(unwind-protect (when (and pathname (not keep))
(funcall thunk stream pathname) (ignore-errors (delete-file pathname))))))
(ignore-errors (delete-file pathname)))))))))
(defmacro with-temporary-file ((&key (stream (gensym "STREAM") streamp) (defmacro with-temporary-file ((&key (stream (gensym "STREAM") streamp)
(pathname (gensym "PATHNAME") pathnamep) (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