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.
dimitri · Apr 29, 2018 · a392328 · a392328
1 parent 01f877b
commit a392328
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 15 deletions.
diff --git a/src/parsers/command-cast-rules.lisp b/src/parsers/command-cast-rules.lisp
@@ -13,18 +13,12 @@
 (defrule cast-unsigned-guard (and kw-when kw-unsigned)
   (: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
 (defrule cast-source-extra (and kw-with kw-extra
                                 (or kw-auto-increment
                                     kw-on-update-current-timestamp))
   (:lambda (extra)
-    (list (third extra) t)))
+    (cons (third extra) t)))
 
 (defrule cast-source-type (and kw-type trimmed-name)
   (:destructure (kw name) (declare (ignore kw)) (list :type name)))
@@ -38,19 +32,23 @@
   ;; well, we want namestring . namestring
   (: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)
-			  (? cast-source-extra)
-			  (? cast-source-guards)
-			  ignore-whitespace)
+                          cast-source-extra-or-guard)
   (:lambda (source)
-    (bind (((name-and-type extra guards _)       source)
+    (bind (((name-and-type extra-and-guards) source)
            ((&key (default nil d-s-p)
                   (typemod nil t-s-p)
                   (unsigned nil u-s-p)
-                  &allow-other-keys)            guards)
-           ((&key (auto-increment nil ai-s-p)
+                  (auto-increment nil ai-s-p)
                   (on-update-current-timestamp nil ouct-s-p)
-                  &allow-other-keys)            extra))
+                  &allow-other-keys)
+            extra-and-guards))
       `(,@name-and-type
 		,@(when t-s-p (list :typemod typemod))
 		,@(when d-s-p (list :default default))

diff --git a/test/mysql/my.load b/test/mysql/my.load
@@ -22,8 +22,14 @@ load database
 
       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
         to "timestamp with time zone" drop extra
 
  BEFORE LOAD DO $$ create schema if not exists mysql; $$;
-