Mercurial > urweb

changeset 2295:e6c5bb62fef8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix SQL parser JOIN bug and fix ON clause logic in Sqlcache.
author Ziv Scully <ziv@mit.edu>
date Thu, 19 Nov 2015 03:45:39 -0500
parents f8903af753ff
children 5104e480b3e3
files caching-tests/test.ur src/sql.sml src/sqlcache.sml
diffstat 3 files changed, 19 insertions(+), 17 deletions(-) [+]
line wrap: on
line diff
--- a/caching-tests/test.ur	Thu Nov 19 01:59:00 2015 -0500
+++ b/caching-tests/test.ur	Thu Nov 19 03:45:39 2015 -0500
@@ -1,12 +1,13 @@
 table tab : {Id : int, Val : int, Foo : int} PRIMARY KEY Id
 
 fun cache id =
-    res <- oneOrNoRows (SELECT tab.Val FROM tab WHERE tab.Id = {[id]});
+    res <- oneOrNoRows (SELECT A.Val FROM (tab AS A JOIN tab AS B ON A.Id = B.Id)
+                                     WHERE B.Id = {[id]});
     return <xml><body>
       cache
       {case res of
            None => <xml>?</xml>
-         | Some row => <xml>{[row.Tab.Val]}</xml>}
+         | Some row => <xml>{[row.A.Val]}</xml>}
     </body></xml>
 
 (* fun cacheAlt id = *)
--- a/src/sql.sml	Thu Nov 19 01:59:00 2015 -0500
+++ b/src/sql.sml	Thu Nov 19 03:45:39 2015 -0500
@@ -384,12 +384,6 @@
 
 datatype jtype = Inner | Left | Right | Full
 
-val jtype = wrap (ws (follow (opt (altL [wrap (const "LEFT") (fn () => Left),
-                                         wrap (const "RIGHT") (fn () => Right),
-                                         wrap (const "FULL") (fn () => Full)]))
-                             (const " JOIN ")))
-                 (fn (SOME jt, ()) => jt | (NONE, ()) => Inner)
-
 datatype fitem =
          Table of string * string (* table AS name *)
        | Join of jtype * fitem * fitem * sqexp
@@ -404,17 +398,22 @@
 
 val orderby = log "orderby"
               (wrap (follow (ws (const "ORDER BY "))
-                            (follow (list sqexp)
-                                    (opt (ws (const "DESC")))))
+                            (list (follow sqexp
+                                          (opt (ws (const "DESC"))))))
                     ignore)
 
+val jtype = altL [wrap (const "JOIN") (fn () => Inner),
+                  wrap (const "LEFT JOIN") (fn () => Left),
+                  wrap (const "RIGHT JOIN") (fn () => Right),
+                  wrap (const "FULL JOIN") (fn () => Full)]
+
 fun fitem chs = altL [wrap (follow uw_ident
                                    (follow (const " AS ")
                                            t_ident))
                            (fn (t, ((), f)) => Table (t, f)),
                       wrap (follow (const "(")
                                    (follow fitem
-                                           (follow jtype
+                                           (follow (ws jtype)
                                                    (follow fitem
                                                            (follow (const " ON ")
                                                                    (follow sqexp
--- a/src/sqlcache.sml	Thu Nov 19 01:59:00 2015 -0500
+++ b/src/sqlcache.sml	Thu Nov 19 03:45:39 2015 -0500
@@ -823,9 +823,12 @@
       | Sql.Join (jt, fi1, fi2, se) =>
         concatMap (fn ((wher1, subst1)) =>
                       map (fn (wher2, subst2) =>
-                              (sqlAnd (wher1, wher2),
-                               (* There should be no name conflicts... Ziv hopes? *)
-                               unionSubst (subst1, subst2)))
+                              let
+                                  val subst = unionSubst (subst1, subst2)
+                              in
+                                  (* ON clause becomes part of the accumulated WHERE. *)
+                                  (sqlAnd (sqlAnd (wher1, wher2), applySubst subst se), subst)
+                              end)
                           (flattenFitem fi2))
                   (flattenFitem fi1)
 
@@ -1362,14 +1365,13 @@
         val {query = queryText, initial, body, ...} = q
         val attempt =
             (* Ziv misses Haskell's do notation.... *)
-            (safe 0 (printExp "attempt" queryText) andalso safe 0 initial andalso safe 2 body)
+            (safe 0 queryText andalso safe 0 initial andalso safe 2 body)
             <\oguard\>
              (fn _ =>
-                 Sql.parse Sql.query (printExp "safe" queryText)
+                 Sql.parse Sql.query queryText
                  <\obind\>
                   (fn queryParsed =>
                       let
-                          val _ = (printExp "parsed" queryText)
                           val invalInfo = InvalInfo.singleton queryParsed
                           fun mkExp state =
                               case cacheExp (env, EQuery q, invalInfo, state) of