# HG changeset patch # User Ziv Scully # Date 1447922739 18000 # Node ID e6c5bb62fef859362966148bb631aef2fd55a978 # Parent f8903af753fffc2676cca3a3cb71f90ac36380ec Fix SQL parser JOIN bug and fix ON clause logic in Sqlcache. diff -r f8903af753ff -r e6c5bb62fef8 caching-tests/test.ur --- 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 cache {case res of None => ? - | Some row => {[row.Tab.Val]}} + | Some row => {[row.A.Val]}} (* fun cacheAlt id = *) diff -r f8903af753ff -r e6c5bb62fef8 src/sql.sml --- 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 diff -r f8903af753ff -r e6c5bb62fef8 src/sqlcache.sml --- 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