ssql: don't wrap prefix and suffix operators in parentheses; fix FROM clause with multiple tables to separate table names with commas; add `order' operator.

git-svn-id: https://code.call-cc.org/svn/chicken-eggs/release/4/ssql/trunk@22909 fca3e652-9b03-0410-8d7b-ac86a6ce46c4
master
syn 14 years ago
parent 9dfb01510d
commit 9ae0559ec2

@ -19,9 +19,10 @@
(let ((ssql-op (first op)) (let ((ssql-op (first op))
(type (second op))) (type (second op)))
(let-optionals (cddr op) (let-optionals (cddr op)
((sql-op (string-upcase (->string (strip-syntax ssql-op))))) ((sql-op (string-upcase (->string (strip-syntax ssql-op))))
(separator #f))
`((,(strip-syntax ssql-op) operands) `((,(strip-syntax ssql-op) operands)
(self 'operator->sql ',type ,sql-op operands))))) (self 'operator->sql ',type ,sql-op ,separator operands)))))
(cddr x)))))))) (cddr x))))))))
(define *ansi-translator* (define *ansi-translator*
@ -69,7 +70,7 @@
(string-upcase (symbol->string type)) (string-upcase (symbol->string type))
(string-join (map (lambda (x) (self 'ssql->sql x)) rest)))))) (string-join (map (lambda (x) (self 'ssql->sql x)) rest))))))
((operator->sql type operator operands) ((operator->sql type operator separator operands)
(case type (case type
((infix) ((infix)
(sprintf "(~A)" (string-intersperse (sprintf "(~A)" (string-intersperse
@ -84,20 +85,20 @@
(map (lambda (operand) (map (lambda (operand)
(self 'ssql->sql operand)) (self 'ssql->sql operand))
operands) operands)
", "))) (or separator ", "))))
((suffix prefix) ((suffix prefix)
(let ((operator (if (eq? type 'prefix) (let ((operator (if (eq? type 'prefix)
(string-append operator " ") (string-append operator " ")
(string-append " " operator)))) (string-append " " operator))))
(sprintf "(~A)" (string-join
(string-join (list
(list (string-intersperse
(string-intersperse (map (lambda (operand)
(map (lambda (operand) (self 'ssql->sql operand))
(self 'ssql->sql operand)) operands)
operands))) (or separator " ")))
operator operator
type)))) type)))
(else (error "unknown operator syntax type" type)))) (else (error "unknown operator syntax type" type))))
((ssql->sql ssql) ((ssql->sql ssql)
@ -108,8 +109,9 @@
(define-operators *ansi-translator* (define-operators *ansi-translator*
(select prefix) (select prefix)
(from prefix) (from prefix "FROM" ", ")
(where prefix) (where prefix)
(order prefix "ORDER BY" ", ")
(having prefix) (having prefix)
(union infix) (union infix)
(as infix) (as infix)

@ -3,22 +3,28 @@
(test-begin "selects") (test-begin "selects")
(test "Simple query" (test "Simple query"
"(SELECT actors.firstname, actors.lastname (FROM actors))" "SELECT actors.firstname, actors.lastname FROM actors"
(ssql->sql #f `(select (columns actors.firstname actors.lastname) (ssql->sql #f `(select (columns actors.firstname actors.lastname)
(from actors)))) (from actors))))
(test "Many columns" (test "Many columns"
"(SELECT actors.id, actors.firstname, actors.lastname, roles.character, roles.movie_id (FROM actors roles))" "SELECT actors.id, actors.firstname, actors.lastname, roles.character, roles.movie_id FROM actors, roles"
(ssql->sql #f `(select (columns (col actors id firstname lastname) (col roles character movie_id)) (ssql->sql #f `(select (columns (col actors id firstname lastname) (col roles character movie_id))
(from actors roles)))) (from actors roles))))
(test "Joined query" (test "Joined query"
(string-append (string-append
"(SELECT actors.firstname, actors.lastname, roles.character, movies.title " "SELECT actors.firstname, actors.lastname, roles.character, movies.title "
"(FROM ((actors LEFT JOIN roles (ON (roles.actor_id = actors.id))) "
"LEFT JOIN movies (ON (movies.id = roles.movie_id)))))") "FROM ((actors LEFT JOIN roles ON (roles.actor_id = actors.id)) "
"LEFT JOIN movies ON (movies.id = roles.movie_id))")
(ssql->sql #f `(select (columns actors.firstname actors.lastname roles.character movies.title) (ssql->sql #f `(select (columns actors.firstname actors.lastname roles.character movies.title)
(from (join left (from (join left
(join left actors roles (join left actors roles
(on (= roles.actor_id actors.id))) (on (= roles.actor_id actors.id)))
movies movies
(on (= movies.id roles.movie_id))))))) (on (= movies.id roles.movie_id)))))))
(test "Order"
"SELECT lastname, firstname FROM people ORDER BY lastname DESC, firstname"
(ssql->sql #f '(select (columns lastname firstname) (from people) (order (desc lastname) firstname))))
(test-end "selects") (test-end "selects")

@ -12,7 +12,7 @@
(test-begin "selects") (test-begin "selects")
(test "Simple query" (test "Simple query"
"(SELECT actors.firstname, actors.lastname (FROM actors))" "SELECT actors.firstname, actors.lastname FROM actors"
(ssql->sql #t `(select (columns actors.firstname actors.lastname) (ssql->sql #t `(select (columns actors.firstname actors.lastname)
(from actors)))) (from actors))))
(test-end "selects") (test-end "selects")

@ -4,3 +4,5 @@
(load-relative "ansi-test") (load-relative "ansi-test")
;; (load "mysql-test") ;; (load "mysql-test")
(load-relative "pgsql-test") (load-relative "pgsql-test")
(test-exit)
Loading…
Cancel
Save