Commit 94ef1526 authored by Robert P. Goldman's avatar Robert P. Goldman

Fix handling of :at key in :read-file-form.

Patch from Vsevolod Dyomkin.
parent e807ead2
......@@ -114,10 +114,12 @@
(case (first form)
((:read-file-form)
(destructuring-bind (subpath &key (at 0)) (rest form)
(safe-read-file-form (subpathname pathname subpath) :at at :package :asdf-user)))
(safe-read-file-form (subpathname pathname subpath)
:at at :package :asdf-user)))
((:read-file-line)
(destructuring-bind (subpath &key (at 0)) (rest form)
(read-file-lines (subpathname pathname subpath) :at at)))
(safe-read-file-line (subpathname pathname subpath)
:at at)))
(otherwise
(invalid))))
(t
......
......@@ -26,9 +26,21 @@
:pathname #.*test-directory*
:version "1.2")
(def-test-system :versioned-system-file-form
:defsystem-depends-on ((:version :test-asdf/file2 "2.1"))
:pathname #.*test-directory*
:version (:read-file-form "version.lisp-expr" :at 0))
(def-test-system :versioned-system-file-line
:defsystem-depends-on ((:version :test-asdf/file2 "2.1"))
:pathname #.*test-directory*
:version (:read-file-line "version.lisp-expr" :at 1))
(defun vtest (name v &optional (true t))
(or (eq true (version-satisfies (find-system name) v))
(error "no satisfaction: ~S version ~A not ~A" name v true)))
(vtest :versioned-system-1 "1.0")
(vtest :versioned-system-2 "1.0")
(vtest :versioned-system-3 "2.0" nil)
(vtest :versioned-system-file-form "1.0")
(vtest :versioned-system-file-line "1.0")
"1.0"
1.0
\ No newline at end of file
......@@ -17,7 +17,8 @@
#:copy-stream-to-stream #:concatenate-files #:copy-file
#:slurp-stream-string #:slurp-stream-lines #:slurp-stream-line
#:slurp-stream-forms #:slurp-stream-form
#:read-file-string #:read-file-lines #:read-file-forms #:read-file-form #:safe-read-file-form
#:read-file-string #:read-file-line #:read-file-lines #:safe-read-file-line
#:read-file-forms #:read-file-form #:safe-read-file-form
#:eval-input #:eval-thunk #:standard-eval-thunk
;; Temporary files
#:*temporary-directory* #:temporary-directory #:default-temporary-directory
......@@ -341,6 +342,14 @@ BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(apply 'call-with-input-file file 'slurp-stream-lines keys))
(defun read-file-line (file &rest keys &key (at 0) &allow-other-keys)
"Open input FILE with option KEYS (except AT),
and read its contents as per SLURP-STREAM-LINE with given AT specifier.
BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(apply 'call-with-input-file file
#'(lambda (input) (slurp-stream-line input :at at))
(remove-plist-key :at keys)))
(defun read-file-forms (file &rest keys &key count &allow-other-keys)
"Open input FILE with option KEYS (except COUNT),
and read its contents as per SLURP-STREAM-FORMS with given COUNT.
......@@ -357,6 +366,13 @@ BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
#'(lambda (input) (slurp-stream-form input :at at))
(remove-plist-key :at keys)))
(defun safe-read-file-line (pathname &rest keys &key (package :cl) &allow-other-keys)
"Reads the specified line from the top of a file using a safe standardized syntax.
Extracts the line using READ-FILE-LINE,
within an WITH-SAFE-IO-SYNTAX using the specified PACKAGE."
(with-safe-io-syntax (:package package)
(apply 'read-file-line pathname (remove-plist-key :package keys))))
(defun safe-read-file-form (pathname &rest keys &key (package :cl) &allow-other-keys)
"Reads the specified form from the top of a file using a safe standardized syntax.
Extracts the form using READ-FILE-FORM,
......
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