[py-configparser-cvs] r19 - in trunk: . tests
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Fri Mar 14 20:17:16 UTC 2008
Author: ehuelsmann
Date: Fri Mar 14 15:17:12 2008
New Revision: 19
Modified:
trunk/LICENSE (contents, props changed)
trunk/README (contents, props changed)
trunk/config.lisp (contents, props changed)
trunk/package.lisp (contents, props changed)
trunk/parser.lisp (contents, props changed)
trunk/py-configparser.asd (contents, props changed)
trunk/tests/py-configparser-tests.asd (contents, props changed)
trunk/tests/tests.lisp (contents, props changed)
Log:
Add 'native' eol-style.
Fix 'declaim' bug reported by Maciek Pasternacki <maciej at pasternacki.net>
through private mail.
Modified: trunk/LICENSE
==============================================================================
--- trunk/LICENSE (original)
+++ trunk/LICENSE Fri Mar 14 15:17:12 2008
@@ -1,23 +1,23 @@
-(This is the MIT / X Consortium license as taken from
- http://www.opensource.org/licenses/mit-license.html)
-
-Copyright (c) 2008 Erik Huelsmann
-
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-"Software"), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
-LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
-OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+(This is the MIT / X Consortium license as taken from
+ http://www.opensource.org/licenses/mit-license.html)
+
+Copyright (c) 2008 Erik Huelsmann
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Modified: trunk/README
==============================================================================
--- trunk/README (original)
+++ trunk/README Fri Mar 14 15:17:12 2008
@@ -1,52 +1,52 @@
-$URL$
-$Id$
-
-py-configparser
-===============
-
-This package provides the same functionality as the Python configparser module,
-implemented in pure Common Lisp.
-
-
-Differences between the two
-===========================
-
-The CL version makes a strong distinction in the parser on one hand and the in-memory
-storage management on the other hand. Because of it, the CL version doesn't call its
-objects 'Parser', but 'config' instead.
-
-The parser/writer part of the package provides the three functions READ-STREAM,
-READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read'
-and 'write'.
-
-
-API mapping
-===========
-
-The functions provided in the Python module (which are all methods of the ConfigParser
-class):
-
-ConfigParser() -> (make-config)
-defaults() -> (defaults <config>)
-sections() -> (sections <config>)
-add_section(name) -> (add-section <config> name)
-has_section(name) -> (has-section-p <config> name)
-options(section_name) -> (options <config> section-name)
-has_option(section_name, name) -> (has-option-p <config> section-name name)
-read(filenames) -> (read-files <config> filenames)
-readfd(fp) -> (read-stream <config> stream)
-get(section, option[, raw[, vars]]) ->
- (get-option <config> section option &key expand defaults type)
-getint(section, option) -> [folded into get-option using 'type' key]
-getfloat(section, option) -> [folded into get-option using 'type' key]
-getboolean(section, option) -> [folded into get-option using 'type' key]
-items(section_name[, raw[, vars]]) -> (items <config> section-name &key expand defaults)
-set(section, option, value) -> (set-option <config> section-name option-name value)
-write(fp) -> (write-stream <config> stream)
-remove_option(section, option) -> (remove-option <config> section-name option-name)
-remove_section(section) -> (remove-section <config> section-name)
-
-Note that the above is just a simple mapping table, but is all you need to get
-you started. Documentation from the ConfigParser module should sufficiently document
-this package. However minor differences in parameter and method naming may occur.
-
+$URL$
+$Id$
+
+py-configparser
+===============
+
+This package provides the same functionality as the Python configparser module,
+implemented in pure Common Lisp.
+
+
+Differences between the two
+===========================
+
+The CL version makes a strong distinction in the parser on one hand and the in-memory
+storage management on the other hand. Because of it, the CL version doesn't call its
+objects 'Parser', but 'config' instead.
+
+The parser/writer part of the package provides the three functions READ-STREAM,
+READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read'
+and 'write'.
+
+
+API mapping
+===========
+
+The functions provided in the Python module (which are all methods of the ConfigParser
+class):
+
+ConfigParser() -> (make-config)
+defaults() -> (defaults <config>)
+sections() -> (sections <config>)
+add_section(name) -> (add-section <config> name)
+has_section(name) -> (has-section-p <config> name)
+options(section_name) -> (options <config> section-name)
+has_option(section_name, name) -> (has-option-p <config> section-name name)
+read(filenames) -> (read-files <config> filenames)
+readfd(fp) -> (read-stream <config> stream)
+get(section, option[, raw[, vars]]) ->
+ (get-option <config> section option &key expand defaults type)
+getint(section, option) -> [folded into get-option using 'type' key]
+getfloat(section, option) -> [folded into get-option using 'type' key]
+getboolean(section, option) -> [folded into get-option using 'type' key]
+items(section_name[, raw[, vars]]) -> (items <config> section-name &key expand defaults)
+set(section, option, value) -> (set-option <config> section-name option-name value)
+write(fp) -> (write-stream <config> stream)
+remove_option(section, option) -> (remove-option <config> section-name option-name)
+remove_section(section) -> (remove-section <config> section-name)
+
+Note that the above is just a simple mapping table, but is all you need to get
+you started. Documentation from the ConfigParser module should sufficiently document
+this package. However minor differences in parameter and method naming may occur.
+
Modified: trunk/config.lisp
==============================================================================
--- trunk/config.lisp (original)
+++ trunk/config.lisp Fri Mar 14 15:17:12 2008
@@ -1,297 +1,297 @@
-
-(cl:in-package :py-configparser)
-
-;; The conditions (errors)
-
-(define-condition configparser-error (error) ())
-
-;; Errors for the configuration management side
-(define-condition config-error (configparser-error) ())
-(define-condition no-section-error (config-error) ())
-(define-condition duplicate-section-error (config-error) ())
-(define-condition no-option-error (config-error) ())
-(define-condition interpolation-error (config-error) ())
-(define-condition interpolation-depth-error (interpolation-error) ())
-(define-condition interpolation-missing-option-error (interpolation-error) ())
-(define-condition interpolation-syntax-error (interpolation-error) ())
-
-
-;;
-;; Configuration storage and management routines
-;;
-
-
-;; The structures
-;; Note: because ABCL has issues with its CLOS support
-;; (as per 1-1-2008), we use structures below to
-;; be maximally portable.
-
-
-(defstruct section
- name
- options)
-
-(defstruct config
- (defaults (make-section :name "DEFAULT"))
- sections
- (option-name-transform-fn #'string-downcase)
- (section-name-transform-fn #'identity))
-
-(defun norm-option-name (config option-name)
- (funcall (config-option-name-transform-fn config) option-name))
-
-(defun norm-section-name (config section-name)
- (funcall (config-section-name-transform-fn config) section-name))
-
-(defun %validate-section-name (name)
- (when (or (= 0 (length name))
- (find #\] name)
- (find #\Newline name)
- (find #\Return name))
- (error 'no-section-error)) ;; Invalid section name, signal so.
- name)
-
-(defun %validate-option-name (name)
- (when (or (= 0 (length name))
- (eql (aref name 0) #\[)
- (find #\Space name)
- (find #\Tab name)
- (find #\Return name)
- (find #\Newline name))
- (error 'no-option-error));; No such option error
- name)
-
-;; non-API
-(defun %get-section (config section-name)
- (if (string= "DEFAULT" section-name)
- (config-defaults config)
- (let* ((norm-section-name (norm-section-name config section-name))
- (section (find norm-section-name (config-sections config)
- :key #'section-name
- :test #'string=)))
- (unless section
- (error 'no-section-error)) ;; no-such-section error
- section)))
-
-;; non-API
-(defun %get-option (config section-name option-name if-does-not-exist)
- (let* ((section (%get-section config section-name))
- (norm-option (norm-option-name config option-name))
- (option (assoc norm-option
- (section-options section)
- :test #'string=)))
- (if (null option)
- (if (eq if-does-not-exist :error)
- (error 'no-option-error) ;; no such option error
- (values (car (push (list (%validate-option-name option-name))
- (section-options section)))
- section))
- (values option section))))
-
-;;
-;; The API
-;;
-
-(defun defaults (config)
- "Returns an alist containing instance wide defaults, where the
-elements are 2-element dotted lists: the CDR is the value
-associated with the key."
- (section-options (config-defaults config)))
-
-(defun sections (config)
- "Returns a list of names of defined sections."
- (mapcar #'section-name (config-sections config)))
-
-(defun has-section-p (config section-name)
- "Returns `NIL' when the section is not added to the config yet,
-some other value if it is."
- (handler-case
- (%get-section config section-name)
- (no-section-error () nil)))
-
-(defun add-section (config section-name)
- "Adds a new section to the config.
-
-If the section exists, the `duplicate-section-error' is raised."
- (%validate-section-name section-name)
- (let ((norm-section-name (funcall (config-section-name-transform-fn config)
- section-name)))
- (when (has-section-p config section-name)
- (error 'duplicate-section-error))
- (car (push (make-section :name norm-section-name)
- (config-sections config)))))
-
-(defun options (config section-name)
- "Returns a list of option names which are defined in the given section."
- (let ((section (%get-section config section-name)))
- (mapcar #'first (section-options section))))
-
-(defun has-option-p (config section-name option-name)
- "Returns a generalised boolean with a value of `NIL' when
-the specified option does not exist in the specified section
-and some other value otherwise."
- (handler-case
- (%get-option config section-name option-name :error)
- (no-option-error () nil)))
-
-;; non-API
-(defun %extract-replacement (option-value)
- ;; Returns: (VALUES replacement-option start end) or NIL
- (let ((%-pos (position #\% option-value)))
- (when (and %-pos
- (< (+ 3 %-pos) (length option-value))
- (eql (aref option-value (1+ %-pos)) #\( ))
- (let ((paren-pos (position #\) option-value :start %-pos)))
- (unless (and paren-pos
- (< (1+ paren-pos) (length option-value))
- (eql (aref option-value (1+ paren-pos)) #\s))
- (error 'interpolation-syntax-error))
- ;; syntax error: %(..)s is minimally required
- (when (<= 0 (- paren-pos %-pos 2))
- (let ((replacement-name
- (make-array (- paren-pos %-pos 2)
- :element-type (array-element-type option-value)
- :displaced-to option-value
- :displaced-index-offset (+ 2 %-pos))))
- (when (= 0 (length replacement-name))
- ;; some preconditions on replacement-name
- (error 'interpolation-syntax-error))
- (values replacement-name %-pos (1+ paren-pos))))))))
-
-;; non-API
-(defun %option-value (config section option-name &key defaults)
- (if (string= option-name "__name__")
- (section-name section)
- (let* ((norm-option-name (norm-option-name config option-name))
- (option (has-option-p config (section-name section) option-name)))
- (if option
- (cdr option)
- (labels ((get-value (repositories)
- (when (null repositories)
- (error 'interpolation-missing-option-error))
- ;; no such option error
- (let ((value (assoc norm-option-name (car repositories)
- :test #'string=)))
- (if value
- (cdr value)
- (get-value (cdr repositories))))))
- (get-value (list (section-options section)
- defaults
- (defaults config))))))))
-
-;; non-API
-(defun %expand-option-value (config section option-value defaults
- &optional dependees)
- (multiple-value-bind
- (replacement-name start end)
- (%extract-replacement option-value)
- (unless replacement-name
- ;; nothing to do here...
- (return-from %expand-option-value option-value))
-
- (let ((norm-replacement (norm-option-name config replacement-name))
- (replacement-value (%option-value config section
- replacement-name
- :defaults defaults)))
- (when (member norm-replacement dependees :test #'string=)
- (error 'interpolation-depth-error)) ;; recursive dependency...
- (%expand-option-value
- config
- section
- (concatenate 'string
- (subseq option-value 0 start)
- (%expand-option-value config
- section
- replacement-value
- defaults
- (cons norm-replacement dependees))
- (subseq option-value (1+ end) (length option-value)))
- defaults
- dependees))))
-
-(defun get-option (config section-name option-name
- &key (expand t) defaults type)
- "Returns the value of the specified option in the specified section.
-
-If `expand' is `NIL', any options which depend on other options
-won't be expanded and the raw configuration value is returned.
-
-When `defaults' is an alist of which the elements are dotted lists of
-key/value pairs, these values are used in the expansion of option values.
-
-`type' may be one of `:boolean', `:number' or it may remain unspecified."
- (multiple-value-bind
- (option section)
- (%get-option config section-name option-name :error)
- (flet ((convert-boolean (v)
- (cond
- ((member v '("1" "yes" "true" "on") :test #'string=)
- T)
- ((member v '("0" "no" "false" "off") :test #'string=)
- NIL)
- (t
- (error 'not-a-boolean))))
- (convert-number (v)
- (parse-number:parse-number v)))
- (let ((string-value
- (if expand
- (%expand-option-value config
- section (cdr option)
- defaults
- (list option-name))
- (cdr option))))
- (cond
- ((eq type :boolean)
- (convert-boolean string-value))
- ((eq type :number)
- (convert-number string-value))
- ((null type)
- string-value)
- (t
- (error "Illegal `type' parameter value.")))))))
-
-(defun set-option (config section-name option-name value)
- "Sets the value of the specified option in the specified section.
-
-If the section does not exist, a `no-section-error' is raised. If the
-option does not exist, it is created."
- (let ((option (%get-option config section-name option-name :create)))
- (setf (cdr option) value)))
-
-(defun items (config section-name &key (expand t) defaults)
- "Returns an alist of which the items are dotted lists of key/value
-pairs being the option names and values specified in the given section.
-
-When `expand' is `NIL', options are returned in raw form. Otherwise
-option values are expanded.
-
-The definition of `defaults' is the same as for `get-option'."
- (let ((section (%get-section config section-name)))
- (if expand
- (mapcar #'(lambda (x)
- (cons (car x) (get-option config section-name
- (car x) ;; option-name
- :expand t
- :defaults defaults)))
- (section-options section))
- (section-options section))))
-
-(defun remove-option (config section-name option-name)
- "Remove the specified option from the given section."
- (multiple-value-bind
- (option section)
- (%get-option config section-name option-name :error)
- (setf (section-options section)
- (remove option (section-options section)))))
-
-(defun remove-section (config section-name)
- "Remove the specified section.
-
-In case the section name equals the magic name `DEFAULT',
-an error is raised, since this section can't be removed."
- (when (string= section-name "DEFAULT")
- (error 'no-section-error)) ;; no such section error
- (let ((section (%get-section config section-name)))
- (setf (config-sections config)
- (remove section (config-sections config)))))
-
+
+(cl:in-package :py-configparser)
+
+;; The conditions (errors)
+
+(define-condition configparser-error (error) ())
+
+;; Errors for the configuration management side
+(define-condition config-error (configparser-error) ())
+(define-condition no-section-error (config-error) ())
+(define-condition duplicate-section-error (config-error) ())
+(define-condition no-option-error (config-error) ())
+(define-condition interpolation-error (config-error) ())
+(define-condition interpolation-depth-error (interpolation-error) ())
+(define-condition interpolation-missing-option-error (interpolation-error) ())
+(define-condition interpolation-syntax-error (interpolation-error) ())
+
+
+;;
+;; Configuration storage and management routines
+;;
+
+
+;; The structures
+;; Note: because ABCL has issues with its CLOS support
+;; (as per 1-1-2008), we use structures below to
+;; be maximally portable.
+
+
+(defstruct section
+ name
+ options)
+
+(defstruct config
+ (defaults (make-section :name "DEFAULT"))
+ sections
+ (option-name-transform-fn #'string-downcase)
+ (section-name-transform-fn #'identity))
+
+(defun norm-option-name (config option-name)
+ (funcall (config-option-name-transform-fn config) option-name))
+
+(defun norm-section-name (config section-name)
+ (funcall (config-section-name-transform-fn config) section-name))
+
+(defun %validate-section-name (name)
+ (when (or (= 0 (length name))
+ (find #\] name)
+ (find #\Newline name)
+ (find #\Return name))
+ (error 'no-section-error)) ;; Invalid section name, signal so.
+ name)
+
+(defun %validate-option-name (name)
+ (when (or (= 0 (length name))
+ (eql (aref name 0) #\[)
+ (find #\Space name)
+ (find #\Tab name)
+ (find #\Return name)
+ (find #\Newline name))
+ (error 'no-option-error));; No such option error
+ name)
+
+;; non-API
+(defun %get-section (config section-name)
+ (if (string= "DEFAULT" section-name)
+ (config-defaults config)
+ (let* ((norm-section-name (norm-section-name config section-name))
+ (section (find norm-section-name (config-sections config)
+ :key #'section-name
+ :test #'string=)))
+ (unless section
+ (error 'no-section-error)) ;; no-such-section error
+ section)))
+
+;; non-API
+(defun %get-option (config section-name option-name if-does-not-exist)
+ (let* ((section (%get-section config section-name))
+ (norm-option (norm-option-name config option-name))
+ (option (assoc norm-option
+ (section-options section)
+ :test #'string=)))
+ (if (null option)
+ (if (eq if-does-not-exist :error)
+ (error 'no-option-error) ;; no such option error
+ (values (car (push (list (%validate-option-name option-name))
+ (section-options section)))
+ section))
+ (values option section))))
+
+;;
+;; The API
+;;
+
+(defun defaults (config)
+ "Returns an alist containing instance wide defaults, where the
+elements are 2-element dotted lists: the CDR is the value
+associated with the key."
+ (section-options (config-defaults config)))
+
+(defun sections (config)
+ "Returns a list of names of defined sections."
+ (mapcar #'section-name (config-sections config)))
+
+(defun has-section-p (config section-name)
+ "Returns `NIL' when the section is not added to the config yet,
+some other value if it is."
+ (handler-case
+ (%get-section config section-name)
+ (no-section-error () nil)))
+
+(defun add-section (config section-name)
+ "Adds a new section to the config.
+
+If the section exists, the `duplicate-section-error' is raised."
+ (%validate-section-name section-name)
+ (let ((norm-section-name (funcall (config-section-name-transform-fn config)
+ section-name)))
+ (when (has-section-p config section-name)
+ (error 'duplicate-section-error))
+ (car (push (make-section :name norm-section-name)
+ (config-sections config)))))
+
+(defun options (config section-name)
+ "Returns a list of option names which are defined in the given section."
+ (let ((section (%get-section config section-name)))
+ (mapcar #'first (section-options section))))
+
+(defun has-option-p (config section-name option-name)
+ "Returns a generalised boolean with a value of `NIL' when
+the specified option does not exist in the specified section
+and some other value otherwise."
+ (handler-case
+ (%get-option config section-name option-name :error)
+ (no-option-error () nil)))
+
+;; non-API
+(defun %extract-replacement (option-value)
+ ;; Returns: (VALUES replacement-option start end) or NIL
+ (let ((%-pos (position #\% option-value)))
+ (when (and %-pos
+ (< (+ 3 %-pos) (length option-value))
+ (eql (aref option-value (1+ %-pos)) #\( ))
+ (let ((paren-pos (position #\) option-value :start %-pos)))
+ (unless (and paren-pos
+ (< (1+ paren-pos) (length option-value))
+ (eql (aref option-value (1+ paren-pos)) #\s))
+ (error 'interpolation-syntax-error))
+ ;; syntax error: %(..)s is minimally required
+ (when (<= 0 (- paren-pos %-pos 2))
+ (let ((replacement-name
+ (make-array (- paren-pos %-pos 2)
+ :element-type (array-element-type option-value)
+ :displaced-to option-value
+ :displaced-index-offset (+ 2 %-pos))))
+ (when (= 0 (length replacement-name))
+ ;; some preconditions on replacement-name
+ (error 'interpolation-syntax-error))
+ (values replacement-name %-pos (1+ paren-pos))))))))
+
+;; non-API
+(defun %option-value (config section option-name &key defaults)
+ (if (string= option-name "__name__")
+ (section-name section)
+ (let* ((norm-option-name (norm-option-name config option-name))
+ (option (has-option-p config (section-name section) option-name)))
+ (if option
+ (cdr option)
+ (labels ((get-value (repositories)
+ (when (null repositories)
+ (error 'interpolation-missing-option-error))
+ ;; no such option error
+ (let ((value (assoc norm-option-name (car repositories)
+ :test #'string=)))
+ (if value
+ (cdr value)
+ (get-value (cdr repositories))))))
+ (get-value (list (section-options section)
+ defaults
+ (defaults config))))))))
+
+;; non-API
+(defun %expand-option-value (config section option-value defaults
+ &optional dependees)
+ (multiple-value-bind
+ (replacement-name start end)
+ (%extract-replacement option-value)
+ (unless replacement-name
+ ;; nothing to do here...
+ (return-from %expand-option-value option-value))
+
+ (let ((norm-replacement (norm-option-name config replacement-name))
+ (replacement-value (%option-value config section
+ replacement-name
+ :defaults defaults)))
+ (when (member norm-replacement dependees :test #'string=)
+ (error 'interpolation-depth-error)) ;; recursive dependency...
+ (%expand-option-value
+ config
+ section
+ (concatenate 'string
+ (subseq option-value 0 start)
+ (%expand-option-value config
+ section
+ replacement-value
+ defaults
+ (cons norm-replacement dependees))
+ (subseq option-value (1+ end) (length option-value)))
+ defaults
+ dependees))))
+
+(defun get-option (config section-name option-name
+ &key (expand t) defaults type)
+ "Returns the value of the specified option in the specified section.
+
+If `expand' is `NIL', any options which depend on other options
+won't be expanded and the raw configuration value is returned.
+
+When `defaults' is an alist of which the elements are dotted lists of
+key/value pairs, these values are used in the expansion of option values.
+
+`type' may be one of `:boolean', `:number' or it may remain unspecified."
+ (multiple-value-bind
+ (option section)
+ (%get-option config section-name option-name :error)
+ (flet ((convert-boolean (v)
+ (cond
+ ((member v '("1" "yes" "true" "on") :test #'string=)
+ T)
+ ((member v '("0" "no" "false" "off") :test #'string=)
+ NIL)
+ (t
+ (error 'not-a-boolean))))
+ (convert-number (v)
+ (parse-number:parse-number v)))
+ (let ((string-value
+ (if expand
+ (%expand-option-value config
+ section (cdr option)
+ defaults
+ (list option-name))
+ (cdr option))))
+ (cond
+ ((eq type :boolean)
+ (convert-boolean string-value))
+ ((eq type :number)
+ (convert-number string-value))
+ ((null type)
+ string-value)
+ (t
+ (error "Illegal `type' parameter value.")))))))
+
+(defun set-option (config section-name option-name value)
+ "Sets the value of the specified option in the specified section.
+
+If the section does not exist, a `no-section-error' is raised. If the
+option does not exist, it is created."
+ (let ((option (%get-option config section-name option-name :create)))
+ (setf (cdr option) value)))
+
+(defun items (config section-name &key (expand t) defaults)
+ "Returns an alist of which the items are dotted lists of key/value
+pairs being the option names and values specified in the given section.
+
+When `expand' is `NIL', options are returned in raw form. Otherwise
+option values are expanded.
+
+The definition of `defaults' is the same as for `get-option'."
+ (let ((section (%get-section config section-name)))
+ (if expand
+ (mapcar #'(lambda (x)
+ (cons (car x) (get-option config section-name
+ (car x) ;; option-name
+ :expand t
+ :defaults defaults)))
+ (section-options section))
+ (section-options section))))
+
+(defun remove-option (config section-name option-name)
+ "Remove the specified option from the given section."
+ (multiple-value-bind
+ (option section)
+ (%get-option config section-name option-name :error)
+ (setf (section-options section)
+ (remove option (section-options section)))))
+
+(defun remove-section (config section-name)
+ "Remove the specified section.
+
+In case the section name equals the magic name `DEFAULT',
+an error is raised, since this section can't be removed."
+ (when (string= section-name "DEFAULT")
+ (error 'no-section-error)) ;; no such section error
+ (let ((section (%get-section config section-name)))
+ (setf (config-sections config)
+ (remove section (config-sections config)))))
+
Modified: trunk/package.lisp
==============================================================================
--- trunk/package.lisp (original)
+++ trunk/package.lisp Fri Mar 14 15:17:12 2008
@@ -1,57 +1,57 @@
-
-;; This package is actuall two things:
-;; 1) a configuration management utility
-;; 2) a configuration file parser/writer in the .INI format
-;;
-;; But in the Python module this distinction hasn't been implemented
-;; this stringently, meaning we're stuck to the current naming scheme.
-
-;; There's no reason however that you can't create your own format
-;; and parse that, storing it in the config object as defined in this
-;; package. (However, if you already use this module, you might as well
-;; use the INI format as persistent format.)
-
-
-(cl:defpackage #:py-configparser
- (:use #:cl)
- (:export
- ;; common condition class
- #:configparser-error
-
- ;; configuration storage type
- #:config
-
- ;; Configuration management
- ;; Error classes
- #:no-section-erorr
- #:duplicate-section-error
- #:no-option-error
- #:interpolation-error
- #:interpolation-depth-error
- #:interpolation-missing-option-error
- #:interpolation-syntax-error
-
- ;; Functions
- #:make-config
- #:defaults
- #:sections
- #:has-section-p
- #:add-section
- #:options
- #:has-option-p
- #:get-option
- #:set-option
- #:items
- #:remove-option
- #:remove-section
-
- ;; Configuration file parsing
- ;; Error classes
- #:parsing-error
- #:missing-section-header-error
-
- ;; Functions
- #:read-stream
- #:read-files
- #:write-stream))
-
+
+;; This package is actuall two things:
+;; 1) a configuration management utility
+;; 2) a configuration file parser/writer in the .INI format
+;;
+;; But in the Python module this distinction hasn't been implemented
+;; this stringently, meaning we're stuck to the current naming scheme.
+
+;; There's no reason however that you can't create your own format
+;; and parse that, storing it in the config object as defined in this
+;; package. (However, if you already use this module, you might as well
+;; use the INI format as persistent format.)
+
+
+(cl:defpackage #:py-configparser
+ (:use #:cl)
+ (:export
+ ;; common condition class
+ #:configparser-error
+
+ ;; configuration storage type
+ #:config
+
+ ;; Configuration management
+ ;; Error classes
+ #:no-section-erorr
+ #:duplicate-section-error
+ #:no-option-error
+ #:interpolation-error
+ #:interpolation-depth-error
+ #:interpolation-missing-option-error
+ #:interpolation-syntax-error
+
+ ;; Functions
+ #:make-config
+ #:defaults
+ #:sections
+ #:has-section-p
+ #:add-section
+ #:options
+ #:has-option-p
+ #:get-option
+ #:set-option
+ #:items
+ #:remove-option
+ #:remove-section
+
+ ;; Configuration file parsing
+ ;; Error classes
+ #:parsing-error
+ #:missing-section-header-error
+
+ ;; Functions
+ #:read-stream
+ #:read-files
+ #:write-stream))
+
Modified: trunk/parser.lisp
==============================================================================
--- trunk/parser.lisp (original)
+++ trunk/parser.lisp Fri Mar 14 15:17:12 2008
@@ -1,235 +1,235 @@
-
-(cl:in-package #:py-configparser)
-
-(declaim '(special *line-no* *current-section* *file-name*
- *current-input*))
-
-;; Errors for the parsing side
-
-(define-condition parsing-error (configparser-error)
- ((line-no :initarg :line-no :initform *line-no* :reader line)
- (file :initarg :file :initform *file-name* :reader file)
- (section :initarg :section :initform *current-section* :reader section)
- (message :initarg :text :reader message))
- (:report (lambda (c stream)
- (format stream "~A at line ~A" (message c) (line c)))))
-(define-condition missing-section-header-error (parsing-error) ())
-
-
-
-;; The reader
-
-(declaim '(inline %read-char %unread-char))
-
-(defun %read-char (stream)
- (let ((ch (read-char stream nil :eof)))
- (when (eql ch #\Newline)
- (incf *line-no*))
- (if (eq ch :eof) #\Newline ch)))
-
-(defun ensure-section (config section-name)
- (handler-case
- (%get-section config section-name)
- (no-section-error ()
- (add-section config section-name)))
- section-name)
-
-(defun is-whitespace (c)
- (or (eq c #\Space)
- (eq c #\Tab)
- (eq c #\Return)))
-
-(defun is-comment-char (c)
- (or (eq c #\;)
- (eq c #\#)))
-
-(defun skip-whitespace (s)
- (loop for c = (%read-char s)
- while (is-whitespace c)))
-
-(defun skip-emtpy-line (s)
- (loop for c = (%read-char s)
- if (eq c #\Newline) do (return)
- else unless (is-whitespace c)
- do (error 'parsing-error
- :text "Non-empty line found where empty expected."))) ;; empty line expected
-
-(defun skip-to-eol (s)
- (loop for c = (%read-char s)
- until (eq c #\Newline)))
-
-(defun expect-char (s expect &key skip-whitespace)
- (let ((ch (%read-char s)))
- (when (and skip-whitespace
- (is-whitespace ch))
- (loop for c = (%read-char s)
- while (is-whitespace c)
- finally (setf ch c)))
- (unless (eq ch expect)
- (error 'parsing-error
- :text (format nil "Character ~A expected, but ~A found instead."
- expect ch))) ;; character expect expected, but ch found
- ch))
-
-(defun expect-one-of (s expect-bag &key skip-whitespace)
- (let ((ch (%read-char s)))
- (when (and skip-whitespace
- (is-whitespace ch))
- (loop for c = (%read-char s)
- while (is-whitespace c)
- finally (setf ch c)))
- (unless (member ch expect-bag)
- ;; character ch found, but looking for EXPECT-BAG
- (error 'parsing-error
- :text (format nil "Character ~A found, but one of ~A expected."
- ch expect-bag)))
- ch))
-
-(defun make-input-buffer (p)
- (declare (ignore p))
- (make-array 20 :element-type 'cl:character :fill-pointer 0
- :adjustable t))
-
-(declaim '(inline extend-input))
-(defun extend-input (p c)
- (vector-push-extend c *current-input* 20))
-
-(defun finalize-input (p)
- (let ((cp *current-input*))
- (setf *current-input*
- (make-input-buffer p))
- cp))
-
-(defun read-section-name (p s)
- (expect-char s #\[)
- (loop for c = (%read-char s)
- if (eq c #\Newline)
- do (error 'parsing-error
- :text "Premature end of line, or end of line in section name.")
- ;; we can't have newlines in section names!
- else if (eq c #\])
- do (progn
- (skip-to-eol s)
- (return (finalize-input p)))
- else do (extend-input p c)))
-
-(defun read-option-name (p s)
- (loop for c = (%read-char s)
- if (or (eq c #\:)
- (eq c #\=))
- do (let ((option-name (finalize-input p)))
- (when (= 0 (length option-name))
- (error 'parsing-error
- :text "No option name found.")) ;; No option name found
- (return option-name))
- else if (is-whitespace c)
- do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s)
- else do (extend-input p c)))
-
-(defun read-option-value (p s &key (leading-white :skip))
- (let ((leading-mode t)
- (lead-detected nil))
- (loop for c = (%read-char s)
- unless (or (eql c #\Return)
- (eql c #\Newline))
- do (if (and leading-mode
- (is-whitespace c))
- (setf lead-detected t)
- (progn
- (when (and (eq leading-white :fold)
- leading-mode
- lead-detected)
- (extend-input p #\Space))
- (setf leading-mode nil)
- (extend-input p c)))
-
- if (and (eql c #\Newline)
- (let ((ch (peek-char nil s nil nil)))
- (or (eql ch #\Space)
- (eql ch #\Tab))))
- do (return (read-option-value p s :leading-white :fold))
- until (eql c #\Newline)
- finally (return (finalize-input p)))))
-
-(defun reading-driver (p s)
- (let ((*line-no* 0)
- (*current-section* nil)
- (*current-input* (make-input-buffer p)))
- (loop for c = (peek-char nil s nil :eof)
- until (eq c :eof)
- if (eql c #\[)
- do (setf *current-section*
- (section-name (ensure-section p (read-section-name p s))))
-
- else if (is-whitespace c)
- do (skip-empty-line s)
-
- else if (is-comment-char c)
- do (skip-to-eol s)
-
- else if (eql c #\Newline)
- do (%read-char s) ;; skip over the newline character
-
- else do (if (null *current-section*)
- (error 'missing-section-header-error
- :text (format nil "Missing section header; found ~A instead." c))
- (set-option p
- *current-section*
- (read-option-name p s)
- (read-option-value p s))))))
-
-;;
-;; The API
-;;
-
-(defun read-files (config filenames)
- "Parses the files given in the list `filenames', if they exist.
-The list is processed first to last, overwriting any pre-existing
-values with the last value read.
-
-The results are stored in `config' which is modified destructively.
-
-Returns as values the configuration and the list of files actually read."
- (let (files-read)
- (dolist (filename (mapcar #'probe-file filenames)
- (values config files-read))
- (with-open-file (s filename
- :direction :input
- :if-does-not-exist :error)
- (read-stream config s :stream-name filename))
- (push filename files-read))))
-
-(defun read-stream (config stream &key (stream-name "an unknown stream"))
- "Parses the content of `stream' as a configuration file,
-storing any values in `config' which is modified destructively.
-
-This function maps from the python 'readfp()' function."
- (let ((*file-name* stream-name))
- (reading-driver config stream)
- config))
-
-(defun %format-value (value)
- (if (and (numberp value)
- (not (integerp value)))
- (format nil "~,,,,,,'eE" value)
- value))
-
-(defun write-stream (config stream)
- "Writes the configuration file corresponding to the
-in-memory config state. Reloading the file
-with `read-stream' or `read-files' will restore config state."
- (flet ((write-section (section)
- (format stream "[~a]~%" (section-name section))
- (format stream "~:{~A = ~{~A~%~}~}~%"
- (mapcar #'(lambda (option)
- (list (car option)
- (list (%format-value (cdr option)))))
- (section-options section)))))
- (let ((*print-radix* nil)
- (*print-base* 10))
- ;; set the printer output as expected by python
- (when (defaults config)
- ;; write the defaults too!!
- (write-section (config-defaults config)))
- (mapcar #'write-section (config-sections config)))))
-
+
+(cl:in-package #:py-configparser)
+
+(declaim (special *line-no* *current-section* *file-name*
+ *current-input*))
+
+;; Errors for the parsing side
+
+(define-condition parsing-error (configparser-error)
+ ((line-no :initarg :line-no :initform *line-no* :reader line)
+ (file :initarg :file :initform *file-name* :reader file)
+ (section :initarg :section :initform *current-section* :reader section)
+ (message :initarg :text :reader message))
+ (:report (lambda (c stream)
+ (format stream "~A at line ~A" (message c) (line c)))))
+(define-condition missing-section-header-error (parsing-error) ())
+
+
+
+;; The reader
+
+(declaim (inline %read-char %unread-char))
+
+(defun %read-char (stream)
+ (let ((ch (read-char stream nil :eof)))
+ (when (eql ch #\Newline)
+ (incf *line-no*))
+ (if (eq ch :eof) #\Newline ch)))
+
+(defun ensure-section (config section-name)
+ (handler-case
+ (%get-section config section-name)
+ (no-section-error ()
+ (add-section config section-name)))
+ section-name)
+
+(defun is-whitespace (c)
+ (or (eq c #\Space)
+ (eq c #\Tab)
+ (eq c #\Return)))
+
+(defun is-comment-char (c)
+ (or (eq c #\;)
+ (eq c #\#)))
+
+(defun skip-whitespace (s)
+ (loop for c = (%read-char s)
+ while (is-whitespace c)))
+
+(defun skip-emtpy-line (s)
+ (loop for c = (%read-char s)
+ if (eq c #\Newline) do (return)
+ else unless (is-whitespace c)
+ do (error 'parsing-error
+ :text "Non-empty line found where empty expected."))) ;; empty line expected
+
+(defun skip-to-eol (s)
+ (loop for c = (%read-char s)
+ until (eq c #\Newline)))
+
+(defun expect-char (s expect &key skip-whitespace)
+ (let ((ch (%read-char s)))
+ (when (and skip-whitespace
+ (is-whitespace ch))
+ (loop for c = (%read-char s)
+ while (is-whitespace c)
+ finally (setf ch c)))
+ (unless (eq ch expect)
+ (error 'parsing-error
+ :text (format nil "Character ~A expected, but ~A found instead."
+ expect ch))) ;; character expect expected, but ch found
+ ch))
+
+(defun expect-one-of (s expect-bag &key skip-whitespace)
+ (let ((ch (%read-char s)))
+ (when (and skip-whitespace
+ (is-whitespace ch))
+ (loop for c = (%read-char s)
+ while (is-whitespace c)
+ finally (setf ch c)))
+ (unless (member ch expect-bag)
+ ;; character ch found, but looking for EXPECT-BAG
+ (error 'parsing-error
+ :text (format nil "Character ~A found, but one of ~A expected."
+ ch expect-bag)))
+ ch))
+
+(defun make-input-buffer (p)
+ (declare (ignore p))
+ (make-array 20 :element-type 'cl:character :fill-pointer 0
+ :adjustable t))
+
+(declaim (inline extend-input))
+(defun extend-input (p c)
+ (vector-push-extend c *current-input* 20))
+
+(defun finalize-input (p)
+ (let ((cp *current-input*))
+ (setf *current-input*
+ (make-input-buffer p))
+ cp))
+
+(defun read-section-name (p s)
+ (expect-char s #\[)
+ (loop for c = (%read-char s)
+ if (eq c #\Newline)
+ do (error 'parsing-error
+ :text "Premature end of line, or end of line in section name.")
+ ;; we can't have newlines in section names!
+ else if (eq c #\])
+ do (progn
+ (skip-to-eol s)
+ (return (finalize-input p)))
+ else do (extend-input p c)))
+
+(defun read-option-name (p s)
+ (loop for c = (%read-char s)
+ if (or (eq c #\:)
+ (eq c #\=))
+ do (let ((option-name (finalize-input p)))
+ (when (= 0 (length option-name))
+ (error 'parsing-error
+ :text "No option name found.")) ;; No option name found
+ (return option-name))
+ else if (is-whitespace c)
+ do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s)
+ else do (extend-input p c)))
+
+(defun read-option-value (p s &key (leading-white :skip))
+ (let ((leading-mode t)
+ (lead-detected nil))
+ (loop for c = (%read-char s)
+ unless (or (eql c #\Return)
+ (eql c #\Newline))
+ do (if (and leading-mode
+ (is-whitespace c))
+ (setf lead-detected t)
+ (progn
+ (when (and (eq leading-white :fold)
+ leading-mode
+ lead-detected)
+ (extend-input p #\Space))
+ (setf leading-mode nil)
+ (extend-input p c)))
+
+ if (and (eql c #\Newline)
+ (let ((ch (peek-char nil s nil nil)))
+ (or (eql ch #\Space)
+ (eql ch #\Tab))))
+ do (return (read-option-value p s :leading-white :fold))
+ until (eql c #\Newline)
+ finally (return (finalize-input p)))))
+
+(defun reading-driver (p s)
+ (let ((*line-no* 0)
+ (*current-section* nil)
+ (*current-input* (make-input-buffer p)))
+ (loop for c = (peek-char nil s nil :eof)
+ until (eq c :eof)
+ if (eql c #\[)
+ do (setf *current-section*
+ (section-name (ensure-section p (read-section-name p s))))
+
+ else if (is-whitespace c)
+ do (skip-empty-line s)
+
+ else if (is-comment-char c)
+ do (skip-to-eol s)
+
+ else if (eql c #\Newline)
+ do (%read-char s) ;; skip over the newline character
+
+ else do (if (null *current-section*)
+ (error 'missing-section-header-error
+ :text (format nil "Missing section header; found ~A instead." c))
+ (set-option p
+ *current-section*
+ (read-option-name p s)
+ (read-option-value p s))))))
+
+;;
+;; The API
+;;
+
+(defun read-files (config filenames)
+ "Parses the files given in the list `filenames', if they exist.
+The list is processed first to last, overwriting any pre-existing
+values with the last value read.
+
+The results are stored in `config' which is modified destructively.
+
+Returns as values the configuration and the list of files actually read."
+ (let (files-read)
+ (dolist (filename (mapcar #'probe-file filenames)
+ (values config files-read))
+ (with-open-file (s filename
+ :direction :input
+ :if-does-not-exist :error)
+ (read-stream config s :stream-name filename))
+ (push filename files-read))))
+
+(defun read-stream (config stream &key (stream-name "an unknown stream"))
+ "Parses the content of `stream' as a configuration file,
+storing any values in `config' which is modified destructively.
+
+This function maps from the python 'readfp()' function."
+ (let ((*file-name* stream-name))
+ (reading-driver config stream)
+ config))
+
+(defun %format-value (value)
+ (if (and (numberp value)
+ (not (integerp value)))
+ (format nil "~,,,,,,'eE" value)
+ value))
+
+(defun write-stream (config stream)
+ "Writes the configuration file corresponding to the
+in-memory config state. Reloading the file
+with `read-stream' or `read-files' will restore config state."
+ (flet ((write-section (section)
+ (format stream "[~a]~%" (section-name section))
+ (format stream "~:{~A = ~{~A~%~}~}~%"
+ (mapcar #'(lambda (option)
+ (list (car option)
+ (list (%format-value (cdr option)))))
+ (section-options section)))))
+ (let ((*print-radix* nil)
+ (*print-base* 10))
+ ;; set the printer output as expected by python
+ (when (defaults config)
+ ;; write the defaults too!!
+ (write-section (config-defaults config)))
+ (mapcar #'write-section (config-sections config)))))
+
Modified: trunk/py-configparser.asd
==============================================================================
--- trunk/py-configparser.asd (original)
+++ trunk/py-configparser.asd Fri Mar 14 15:17:12 2008
@@ -1,20 +1,20 @@
-
-
-(in-package #:cl-user)
-
-(defpackage #:py-configparser-system
- (:use #:cl #:asdf))
-
-(in-package #:py-configparser-system)
-
-(defsystem py-configparser
- :name "py-configparser"
- :author "Erik Huelsmann"
- :version "1.1-dev"
- :license "MIT"
- :description "Common Lisp implementation of the Python ConfigParser module"
- :depends-on (#:parse-number)
- :components ((:file "package")
- (:file "config" :depends-on ("package"))
- (:file "parser" :depends-on ("config"))))
-
+
+
+(in-package #:cl-user)
+
+(defpackage #:py-configparser-system
+ (:use #:cl #:asdf))
+
+(in-package #:py-configparser-system)
+
+(defsystem py-configparser
+ :name "py-configparser"
+ :author "Erik Huelsmann"
+ :version "1.1-dev"
+ :license "MIT"
+ :description "Common Lisp implementation of the Python ConfigParser module"
+ :depends-on (#:parse-number)
+ :components ((:file "package")
+ (:file "config" :depends-on ("package"))
+ (:file "parser" :depends-on ("config"))))
+
Modified: trunk/tests/py-configparser-tests.asd
==============================================================================
--- trunk/tests/py-configparser-tests.asd (original)
+++ trunk/tests/py-configparser-tests.asd Fri Mar 14 15:17:12 2008
@@ -1,17 +1,17 @@
-
-
-(in-package #:cl-user)
-
-(defpackage #:py-configparser-tests-system
- (:use #:cl #:asdf))
-
-(in-package #:py-configparser-tests-system)
-
-(defsystem py-configparser-tests
- :name "py-configparser-tests"
- :author "Erik Huelsmann"
- :version "1.0-dev"
- :license "MIT"
- :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'"
- :depends-on (#:py-configparser)
- :components ((:file "tests")))
+
+
+(in-package #:cl-user)
+
+(defpackage #:py-configparser-tests-system
+ (:use #:cl #:asdf))
+
+(in-package #:py-configparser-tests-system)
+
+(defsystem py-configparser-tests
+ :name "py-configparser-tests"
+ :author "Erik Huelsmann"
+ :version "1.0-dev"
+ :license "MIT"
+ :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'"
+ :depends-on (#:py-configparser)
+ :components ((:file "tests")))
Modified: trunk/tests/tests.lisp
==============================================================================
--- trunk/tests/tests.lisp (original)
+++ trunk/tests/tests.lisp Fri Mar 14 15:17:12 2008
@@ -1,304 +1,304 @@
-
-(defpackage #:py-configparser-tests
- (:use (#:cl #:py-configparser #:rt)))
-
-(in-package :py-configparser-tests)
-
-;; test 1
-;; should succeed
-(deftest basic.parser
- (typep (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-")
- (read-stream (make-config) s)) 'config)
- T)
-
-(deftest basic.get-option.1
- (with-input-from-string (s "[n]
-p=q
-z=%(p)s
- and some more
-")
- (equal (get-option (read-stream (make-config) s) "n" "z")
- "q and some more"))
- T)
-
-(deftest basic.get-option.2
- (with-input-from-string (s "[n]
-p=q
-delta=%(gamma)s
-z=%(p)s
- and some more
-")
- (equal (get-option (read-stream (make-config) s) "n" "delta" :defaults '(("gamma" . "the gamma value")))
- "the gamma value"))
- T)
-
-(deftest basic.get-option.3
- (with-input-from-string (s "[n]
-p=15
-delta=%(gamma)s
-z=%(p)s
- and some more
-")
- (equal (get-option (read-stream (make-config) s) "n" "p" :type :number)
- 15))
- T)
-
-(deftest basic.get-option.4
- (with-input-from-string (s "[n]
-p=yes
-delta=%(gamma)s
-z=%(p)s
- and some more
-")
- (equal (get-option (read-stream (make-config) s) "n" "p" :type :boolean)
- T))
- T)
-
-(deftest basic.get-option.5
- (with-input-from-string (s "[n]
-p=q
-delta=%(gamma)s
-z=%(p)s
- and some more
-
-[DEFAULT]
-gamma=the gamma value
-")
- (equal (get-option (read-stream (make-config) s) "n" "delta")
- "the gamma value"))
- T)
-
-
-(deftest basic.sections
- (with-input-from-string (s "[n] post-section header gunk ignored
-p=q
-z=%(p)s
-")
- (equal (sections (read-stream (make-config) s))
- '("n")))
- T)
-
-(deftest basic.comments-only
- (typep (with-input-from-string (s "#comments only
-")
- (read-stream (make-config) s)) 'config)
- T)
-
-(deftest basic.no-newline
- (typep (with-input-from-string (s "#comments without trailing \#Newline")
- (read-stream (make-config) s))
- 'config)
- T)
-
-(deftest basic.with-defaults
- (equal (with-input-from-string (s "[DEFAULT]
-def-option = options without trailing newline")
- (get-option (read-stream (make-config) s) "DEFAULT" "def-option"))
- "options without trailing newline")
- T)
-
-;; newlines only
-(deftest basic.newlines-only
- (with-input-from-string (s "
-
-
-")
- (typep (get-option read-stream (make-config) s)
- 'config))
- T)
-
-;; options
-(deftest basic.options
- (equal (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-")
- (options (read-stream (make-config) s) "n")) '("z" "p"))
- T)
-
-;; items
-(deftest basic.items.1
- (equal (with-inputfrom-string (s "[n]
-p=q
-z=%(p)s
-")
- (items (read-stream (make-config) s) "n" :expand nil)) '(("z" "%(p)s") ("p" . "q")))
- T)
-
-(deftest basic.items.2
- (equal (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-")
- (items (read-stream (make-config) s) "n" :expand t)) '(("z" . "q") ("p" . "q")))
- T)
-
-(deftest basic.items.3
- (equal (with-input-from-string (s "[n]
-p=q
-delta=%(gamma)s
-z=%(p)s
-")
- (items (read-stream (make-config) s) "n" :expand t
- :defaults '(("gamma" . "the gamma"))))
- '(("z" . "q") ("delta" . "the gamma") ("p" . "q")))
- T)
-
-
-;; sections
-(deftest basic.sections.1
- (equal (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-
-[v]
-[t]
-")
- (sections (read-stream (make-config) s))) '("t" "v" "n"))
- T)
-
-(deftest basic.sections.2
- (equal (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-
-[v]
-[t]
-
-[DEFAULT]
-p=t
-")
- (sections (read-stream (make-config) s))) '("t" "v" "n"))
- T)
-
-;; add-section
-(deftest basic.add-section
- (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-
-[t]
-
-")
- (let ((c (read-stream (make-config) s)))
- (unless (has-section-p c "v")
- (add-section c "v")
- (not (null (has-section-p c "v"))))))
- T)
-
-;; set-option
-(deftest basic.set-option.1
- (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-
-[t]
-
-")
- (let ((c (read-stream (make-config) s)))
- (unless (has-option-p c "t" "b")
- (set-option c "t" "b" "ok")
- (equal (get-option c "t" "b") "ok"))))
- T)
-
-(deftest basic.set-option.2
- (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-
-[t]
-
-")
- (let ((c (read-stream (make-config) s)))
- (set-option c "n" "p" "ok")
- (equal (get-option c "n" "p") "ok")))
- T)
-
-;; remove-option
-(deftest basic.remove-option
- (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-
-[t]
-
-")
- (let ((c (read-stream (make-config) s)))
- (when (has-option-p c "n" "p")
- (remove-option c "n" "p")
- (null (has-option-p c "n" "p")))))
- T)
-
-;; remove-section
-(deftest basic.remove-section
- (with-input-from-string (s "[n]
-p=q
-z=%(p)s
-
-[t]
-
-")
- (let ((c (read-stream (make-config) s)))
- (when (has-section-p c "t")
- (remove-section c "t")
- (null (has-section-p c "t")))))
- T)
-
-
-
-;; now the tests that fail
-(deftest failures.no-header
- (with-input-from-string (s "option-before = section
-[header]")
- (handler-case
- (progn
- (read-stream (make-config) s)
- nil)
- (missing-section-header-error () T)))
- T)
-
-(deftest failures.no-spaced-option-names
- (with-input-from-string (s "[n]
-option with space = not allowed
-")
- (handler-case
- (progn
- (read-stream (make-config) s)
- nil)
- (parsing-error () T)))
- T)
-
-(deftest failures.recursion
- (with-input-from-string (s "[n]
-p=%(z)s
-z=%(p)s
-")
- (handler-case
- (get-option (read-stream (make-config) s)
- "n" ;; section
- "p" ;; option
- :expand t)
- (interpolation-depth-error () T)))
- T)
-
-;; non-erroring non-parsing tests
-(deftest miscelaneous
- (with-input-from-string (s "[n]
-p=%(__name__)s
-q=%(z)s
-z=hello
-")
- (let ((p (read-stream (make-config) s)))
- (unless (string= (get-option p "n" "p" :expand t) "n")
- (error "Unexpected output"))
- (unless (string= (get-option p "n" "q" :expand nil) "%(z)s")
- (error "Unexpected output"))
- (unless (string= (get-option p "n" "q" :expand t) "hello")
- (error "Unexpected output"))
- (unless (string= (get-option p "n" "z") "hello")
- (error "Unexpected output"))
- NIL))
+
+(defpackage #:py-configparser-tests
+ (:use (#:cl #:py-configparser #:rt)))
+
+(in-package :py-configparser-tests)
+
+;; test 1
+;; should succeed
+(deftest basic.parser
+ (typep (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+")
+ (read-stream (make-config) s)) 'config)
+ T)
+
+(deftest basic.get-option.1
+ (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+ and some more
+")
+ (equal (get-option (read-stream (make-config) s) "n" "z")
+ "q and some more"))
+ T)
+
+(deftest basic.get-option.2
+ (with-input-from-string (s "[n]
+p=q
+delta=%(gamma)s
+z=%(p)s
+ and some more
+")
+ (equal (get-option (read-stream (make-config) s) "n" "delta" :defaults '(("gamma" . "the gamma value")))
+ "the gamma value"))
+ T)
+
+(deftest basic.get-option.3
+ (with-input-from-string (s "[n]
+p=15
+delta=%(gamma)s
+z=%(p)s
+ and some more
+")
+ (equal (get-option (read-stream (make-config) s) "n" "p" :type :number)
+ 15))
+ T)
+
+(deftest basic.get-option.4
+ (with-input-from-string (s "[n]
+p=yes
+delta=%(gamma)s
+z=%(p)s
+ and some more
+")
+ (equal (get-option (read-stream (make-config) s) "n" "p" :type :boolean)
+ T))
+ T)
+
+(deftest basic.get-option.5
+ (with-input-from-string (s "[n]
+p=q
+delta=%(gamma)s
+z=%(p)s
+ and some more
+
+[DEFAULT]
+gamma=the gamma value
+")
+ (equal (get-option (read-stream (make-config) s) "n" "delta")
+ "the gamma value"))
+ T)
+
+
+(deftest basic.sections
+ (with-input-from-string (s "[n] post-section header gunk ignored
+p=q
+z=%(p)s
+")
+ (equal (sections (read-stream (make-config) s))
+ '("n")))
+ T)
+
+(deftest basic.comments-only
+ (typep (with-input-from-string (s "#comments only
+")
+ (read-stream (make-config) s)) 'config)
+ T)
+
+(deftest basic.no-newline
+ (typep (with-input-from-string (s "#comments without trailing \#Newline")
+ (read-stream (make-config) s))
+ 'config)
+ T)
+
+(deftest basic.with-defaults
+ (equal (with-input-from-string (s "[DEFAULT]
+def-option = options without trailing newline")
+ (get-option (read-stream (make-config) s) "DEFAULT" "def-option"))
+ "options without trailing newline")
+ T)
+
+;; newlines only
+(deftest basic.newlines-only
+ (with-input-from-string (s "
+
+
+")
+ (typep (get-option read-stream (make-config) s)
+ 'config))
+ T)
+
+;; options
+(deftest basic.options
+ (equal (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+")
+ (options (read-stream (make-config) s) "n")) '("z" "p"))
+ T)
+
+;; items
+(deftest basic.items.1
+ (equal (with-inputfrom-string (s "[n]
+p=q
+z=%(p)s
+")
+ (items (read-stream (make-config) s) "n" :expand nil)) '(("z" "%(p)s") ("p" . "q")))
+ T)
+
+(deftest basic.items.2
+ (equal (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+")
+ (items (read-stream (make-config) s) "n" :expand t)) '(("z" . "q") ("p" . "q")))
+ T)
+
+(deftest basic.items.3
+ (equal (with-input-from-string (s "[n]
+p=q
+delta=%(gamma)s
+z=%(p)s
+")
+ (items (read-stream (make-config) s) "n" :expand t
+ :defaults '(("gamma" . "the gamma"))))
+ '(("z" . "q") ("delta" . "the gamma") ("p" . "q")))
+ T)
+
+
+;; sections
+(deftest basic.sections.1
+ (equal (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+
+[v]
+[t]
+")
+ (sections (read-stream (make-config) s))) '("t" "v" "n"))
+ T)
+
+(deftest basic.sections.2
+ (equal (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+
+[v]
+[t]
+
+[DEFAULT]
+p=t
+")
+ (sections (read-stream (make-config) s))) '("t" "v" "n"))
+ T)
+
+;; add-section
+(deftest basic.add-section
+ (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+
+[t]
+
+")
+ (let ((c (read-stream (make-config) s)))
+ (unless (has-section-p c "v")
+ (add-section c "v")
+ (not (null (has-section-p c "v"))))))
+ T)
+
+;; set-option
+(deftest basic.set-option.1
+ (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+
+[t]
+
+")
+ (let ((c (read-stream (make-config) s)))
+ (unless (has-option-p c "t" "b")
+ (set-option c "t" "b" "ok")
+ (equal (get-option c "t" "b") "ok"))))
+ T)
+
+(deftest basic.set-option.2
+ (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+
+[t]
+
+")
+ (let ((c (read-stream (make-config) s)))
+ (set-option c "n" "p" "ok")
+ (equal (get-option c "n" "p") "ok")))
+ T)
+
+;; remove-option
+(deftest basic.remove-option
+ (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+
+[t]
+
+")
+ (let ((c (read-stream (make-config) s)))
+ (when (has-option-p c "n" "p")
+ (remove-option c "n" "p")
+ (null (has-option-p c "n" "p")))))
+ T)
+
+;; remove-section
+(deftest basic.remove-section
+ (with-input-from-string (s "[n]
+p=q
+z=%(p)s
+
+[t]
+
+")
+ (let ((c (read-stream (make-config) s)))
+ (when (has-section-p c "t")
+ (remove-section c "t")
+ (null (has-section-p c "t")))))
+ T)
+
+
+
+;; now the tests that fail
+(deftest failures.no-header
+ (with-input-from-string (s "option-before = section
+[header]")
+ (handler-case
+ (progn
+ (read-stream (make-config) s)
+ nil)
+ (missing-section-header-error () T)))
+ T)
+
+(deftest failures.no-spaced-option-names
+ (with-input-from-string (s "[n]
+option with space = not allowed
+")
+ (handler-case
+ (progn
+ (read-stream (make-config) s)
+ nil)
+ (parsing-error () T)))
+ T)
+
+(deftest failures.recursion
+ (with-input-from-string (s "[n]
+p=%(z)s
+z=%(p)s
+")
+ (handler-case
+ (get-option (read-stream (make-config) s)
+ "n" ;; section
+ "p" ;; option
+ :expand t)
+ (interpolation-depth-error () T)))
+ T)
+
+;; non-erroring non-parsing tests
+(deftest miscelaneous
+ (with-input-from-string (s "[n]
+p=%(__name__)s
+q=%(z)s
+z=hello
+")
+ (let ((p (read-stream (make-config) s)))
+ (unless (string= (get-option p "n" "p" :expand t) "n")
+ (error "Unexpected output"))
+ (unless (string= (get-option p "n" "q" :expand nil) "%(z)s")
+ (error "Unexpected output"))
+ (unless (string= (get-option p "n" "q" :expand t) "hello")
+ (error "Unexpected output"))
+ (unless (string= (get-option p "n" "z") "hello")
+ (error "Unexpected output"))
+ NIL))
NIL)
\ No newline at end of file
More information about the Py-configparser-cvs
mailing list