#lang scheme/base (require mzlib/etc scheme/unit) (require (file "../snooze.ss") (file "../test-base.ss") (file "../test-data.ss") (file "../generic/sql-query-helpers-sig.ss") (file "../generic/sql-query-unit.ss") (file "../generic/sql-query-sig.ss") (file "sql-data-unit.ss") (file "sql-name-unit.ss")) ; Unit invocations ----------------------------- (define-compound-unit/infer query@ (import) (export sql-query^ sql-query-helpers^) (link sql-name@ sql-data@ sql-query@)) (define-values/invoke-unit/infer query@) ; Helpers -------------------------------------- ; (a b c ... output-port -> void) a b c ... -> string ; ; Calls the supplied SQL display procedure, captures its output ; in an output-string, and returns it as a string. (define (capture-sql proc . args) (define out (open-output-string)) (apply proc (append args (list out))) (get-output-string out)) ; any (listof column) -> string (define (distinct-sql val imported) (capture-sql display-distinct val imported)) (define (what-sql val imported) (capture-sql display-what val imported)) (define (from-sql val imported) (capture-sql display-from val imported)) (define (group-sql val imported) (capture-sql display-group val imported)) (define (order-sql val imported) (capture-sql display-order val imported)) (define (expression-sql val imported) (capture-sql display-expression val imported)) ; entity-alias attribute-alias ... (define-alias p1 person) (define-alias p2 person) ; expression-alias (define count-star (sql:alias 'count-star (sql:count*))) (define count-p1 (sql:alias 'count-p1 (sql:count* p1))) (define count-p1-id (sql:alias 'count-p1-id (sql:count p1-id))) (define count-p2-id (sql:alias 'count-p2-id (sql:count p2-id))) (define sum-ids (sql:alias 'sum-ids (sql:+ p1-id p2-id))) ; Tests ---------------------------------------- ; test-suite (define sql-query-unit-tests (test-suite "sql-query-unit.ss" (test-case "display-distinct" (check-equal? (distinct-sql (list) (list)) "DISTINCT " "no expressions") (check-equal? (distinct-sql (list (sql:= p1-id 123)) (list p1-id)) #<string "a" "b") null) "(to_char('a', 'b'))" "sql:->string") (check-equal? (expression-sql (sql:->symbol "a" "b") null) "(to_char('a', 'b'))" "sql:->symbol") (check-equal? (expression-sql (sql:cond [#t "a"] [#f "b"]) null) "(CASE WHEN true THEN 'a' WHEN false THEN 'b' ELSE NULL END)" "sql:cond, no else") (check-equal? (expression-sql (sql:cond [#t "a"] [#f "b"] [else "c"]) null) "(CASE WHEN true THEN 'a' WHEN false THEN 'b' ELSE 'c' END)" "sql:cond, with else")) (test-case "query-sql" (begin-with-definitions (define-alias a person) (define-alias b pet) (define-alias expr (sql:count* b)) (define query1 (sql:select #:what (list a b) #:from (sql:inner a b (sql:= a-id b-owner-id)) #:where (sql:= a-name "Jon Arbuckle") #:order (list (sql:asc a-name) (sql:asc b-name)) #:limit 10 #:offset 20)) (define query2 (sql:select #:what (list a b) #:from (sql:inner (sql:alias 'subq (sql:select #:from a)) b (sql:= a-id b-owner-id)) #:where (sql:= a-name b-name) #:order (list (sql:asc a-name) (sql:asc b-name)))) (define query3 (sql:select #:what (list a expr) #:from (sql:inner a b (sql:= a-id b-owner-id)) #:group (list a))) (define sql1 #<