From 94ef1526c3f9fabfb6f76102b1bcf44213d02d40 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@gmail.com> Date: Thu, 15 Aug 2013 09:23:32 -0500 Subject: [PATCH] Fix handling of :at key in :read-file-form. Patch from Vsevolod Dyomkin. --- defsystem.lisp | 6 ++++-- test/test-version.script | 12 ++++++++++++ test/version.lisp-expr | 2 ++ uiop/stream.lisp | 18 +++++++++++++++++- 4 files changed, 35 insertions(+), 3 deletions(-) create mode 100644 test/version.lisp-expr diff --git a/defsystem.lisp b/defsystem.lisp index 6349bac0..2a3baab9 100644 --- a/defsystem.lisp +++ b/defsystem.lisp @@ -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 diff --git a/test/test-version.script b/test/test-version.script index 0da057dc..63cc8802 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -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") diff --git a/test/version.lisp-expr b/test/version.lisp-expr new file mode 100644 index 00000000..50608ec1 --- /dev/null +++ b/test/version.lisp-expr @@ -0,0 +1,2 @@ +"1.0" +1.0 \ No newline at end of file diff --git a/uiop/stream.lisp b/uiop/stream.lisp index 8cb16ca2..13d21ddd 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -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, -- GitLab