Allow any ordering of guards and extra cast rule clauses.

It used to be that extra were forced to being parsed before guards, but
there's no reason why a user wouldn't think to write its clauses the other
way round, so add support for that as well.

See #779.
This commit is contained in:
Dimitri Fontaine 2018-04-29 18:58:24 +02:00
parent 01f877bad7
commit a392328dad
2 changed files with 19 additions and 15 deletions

View File

@ -13,18 +13,12 @@
(defrule cast-unsigned-guard (and kw-when kw-unsigned) (defrule cast-unsigned-guard (and kw-when kw-unsigned)
(:constant (cons :unsigned t))) (:constant (cons :unsigned t)))
(defrule cast-source-guards (* (or cast-unsigned-guard
cast-default-guard
cast-typemod-guard))
(:lambda (guards)
(alexandria:alist-plist guards)))
;; at the moment we only know about extra auto_increment ;; at the moment we only know about extra auto_increment
(defrule cast-source-extra (and kw-with kw-extra (defrule cast-source-extra (and kw-with kw-extra
(or kw-auto-increment (or kw-auto-increment
kw-on-update-current-timestamp)) kw-on-update-current-timestamp))
(:lambda (extra) (:lambda (extra)
(list (third extra) t))) (cons (third extra) t)))
(defrule cast-source-type (and kw-type trimmed-name) (defrule cast-source-type (and kw-type trimmed-name)
(:destructure (kw name) (declare (ignore kw)) (list :type name))) (:destructure (kw name) (declare (ignore kw)) (list :type name)))
@ -38,19 +32,23 @@
;; well, we want namestring . namestring ;; well, we want namestring . namestring
(:destructure (kw name) (declare (ignore kw)) name)) (:destructure (kw name) (declare (ignore kw)) name))
(defrule cast-source-extra-or-guard (* (or cast-unsigned-guard
cast-default-guard
cast-typemod-guard
cast-source-extra))
(:function alexandria:alist-plist))
(defrule cast-source (and (or cast-source-type cast-source-column) (defrule cast-source (and (or cast-source-type cast-source-column)
(? cast-source-extra) cast-source-extra-or-guard)
(? cast-source-guards)
ignore-whitespace)
(:lambda (source) (:lambda (source)
(bind (((name-and-type extra guards _) source) (bind (((name-and-type extra-and-guards) source)
((&key (default nil d-s-p) ((&key (default nil d-s-p)
(typemod nil t-s-p) (typemod nil t-s-p)
(unsigned nil u-s-p) (unsigned nil u-s-p)
&allow-other-keys) guards) (auto-increment nil ai-s-p)
((&key (auto-increment nil ai-s-p)
(on-update-current-timestamp nil ouct-s-p) (on-update-current-timestamp nil ouct-s-p)
&allow-other-keys) extra)) &allow-other-keys)
extra-and-guards))
`(,@name-and-type `(,@name-and-type
,@(when t-s-p (list :typemod typemod)) ,@(when t-s-p (list :typemod typemod))
,@(when d-s-p (list :default default)) ,@(when d-s-p (list :default default))

View File

@ -22,8 +22,14 @@ load database
type smallint when unsigned to int drop typemod, type smallint when unsigned to int drop typemod,
type timestamp
when default "CURRENT_TIMESTAMP"
with extra on update current timestamp
to "timestamp with time zone"
drop default drop not null drop extra
using zero-dates-to-null,
type timestamp with extra on update current timestamp type timestamp with extra on update current timestamp
to "timestamp with time zone" drop extra to "timestamp with time zone" drop extra
BEFORE LOAD DO $$ create schema if not exists mysql; $$; BEFORE LOAD DO $$ create schema if not exists mysql; $$;