Commit c124d532 authored by Michael R. Mauger's avatar Michael R. Mauger

Correct implementation of `sql-set-product-feature' (Bug#30494).

* lisp.progmodes/sql.el (sql-add-product): Correct argument spec.
(sql-set-product-feature): Handle all cases as intended.
(sql-get-product-feature): Fetch varaiable value by `eval'.
* test/lisp/progmodes/sql-tests.el (sql-test-feature-value-[a-d]):
New test variables.
(sql-test-product-feature-harness): New test macro.
(sql-test-add-product, sql-test-add-existing-product)
(sql-test-set-feature, sql-test-set-indirect-feature)
(sql-test-set-existing-feature)
(sql-test-set-existing-indirect-feature)
(sql-test-set-missing-product, sql-test-get-feature)
(sql-test-get-indirect-feature, sql-test-get-missing-product)
(sql-test-get-missing-feature)
(sql-test-get-missing-indirect-feature): New ERT tests
parent 4d91e646
Pipeline #829 failed with stage
in 50 minutes and 59 seconds
......@@ -2725,7 +2725,7 @@ highlighting rules in SQL mode.")
nil 'require-match
init 'sql-product-history init))))
(defun sql-add-product (product display &rest plist)
(defun sql-add-product (product display &optional plist)
"Add support for a database product in `sql-mode'.
Add PRODUCT to `sql-product-alist' which enables `sql-mode' to
......@@ -2782,19 +2782,38 @@ list. See `sql-add-product' to add new products. The FEATURE
argument must be a plist keyword accepted by
`sql-product-alist'."
(let* ((p (assoc product sql-product-alist))
(v (plist-get (cdr p) feature)))
(if (and p v)
(if (and
(member feature sql-indirect-features)
(symbolp v))
(set v newvalue)
(setcdr p (plist-put (cdr p) feature newvalue)))
(progn
(when (null p)
(error "`%s' is not a known product; use `sql-add-product' to add it first." product))
(when (null v)
(error "`%s' is not a known feature for `%s'; use `sql-add-product' to add it first." feature product))))))
(let* ((p (assoc product sql-product-alist)) ;; (PRODUCT :f v ...)
(v (plist-member (cdr p) feature))) ;; (:FEATURE value ...) or null
(if p
(if (member feature sql-indirect-features) ; is indirect
(if v
(if (car (cdr v))
(if (symbolp (car (cdr v)))
;; Indirect reference
(set (car (cdr v)) newvalue)
;; indirect is not a symbol
(error "The value of `%s' for `%s' is not a symbol" feature product))
;; keyword present, set the indirect variable name
(if (symbolp newvalue)
(if (cdr v)
(setf (car (cdr v)) newvalue)
(setf (cdr v) (list newvalue)))
(error "The indirect variable of `%s' for `%s' must be a symbol" feature product)))
;; not present; insert list
(setq v (list feature newvalue))
(setf (cdr (cdr v)) (cdr p))
(setf (cdr p) v))
;; Not an indirect feature
(if v
(if (cdr v)
(setf (car (cdr v)) newvalue)
(setf (cdr v) (list newvalue)))
;; no value; insert into the list
(setq v (list feature newvalue))
(setf (cdr (cdr v)) (cdr p))
(setf (cdr p) v)))
(error "`%s' is not a known product; use `sql-add-product' to add it first" product))))
(defun sql-get-product-feature (product feature &optional fallback not-indirect)
"Lookup FEATURE associated with a SQL PRODUCT.
......@@ -2822,7 +2841,7 @@ See `sql-product-alist' for a list of products and supported features."
(member feature sql-indirect-features)
(not not-indirect)
(symbolp v))
(symbol-value v)
(eval v)
v))
(error "`%s' is not a known product; use `sql-add-product' to add it first." product)
nil)))
......
This diff is collapsed.
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