Compare commits
	
		
			1 Commits 
		
	
	
	| Author | SHA1 | Date | 
|---|---|---|
| 
							
							
								 | 
						7f766a0c20 | 6 years ago | 
@ -0,0 +1,8 @@
 | 
			
		||||
((version "0.1.2")
 | 
			
		||||
 (synopsis "SSQL translator for PostgreSQL")
 | 
			
		||||
 (category db)
 | 
			
		||||
 (dependencies ssql postgresql)
 | 
			
		||||
 (test-dependencies test)
 | 
			
		||||
 (license "BSD")
 | 
			
		||||
 (author "Peter Bex, Moritz Heidkamp")
 | 
			
		||||
 (components (extension ssql-postgresql)))
 | 
			
		||||
@ -1,50 +1,12 @@
 | 
			
		||||
(cond-expand
 | 
			
		||||
  (chicken-4
 | 
			
		||||
    (load-relative "../ssql-postgresql")
 | 
			
		||||
    (use ssql)
 | 
			
		||||
    (import ssql-postgresql)
 | 
			
		||||
(use test postgresql foops)
 | 
			
		||||
 | 
			
		||||
(define *test-postgresql-translator* 
 | 
			
		||||
  (derive-object (*postgresql-translator* self super)
 | 
			
		||||
                 ((escape-string string)
 | 
			
		||||
                  (string-translate* string '(("'" . "''"))))))
 | 
			
		||||
 | 
			
		||||
(register-sql-engine! (lambda (x) (eq? x #t)) *test-postgresql-translator*)
 | 
			
		||||
 | 
			
		||||
(test-group "selects"
 | 
			
		||||
  (test "Simple query"
 | 
			
		||||
    "SELECT actors.firstname, actors.lastname FROM actors"
 | 
			
		||||
    (ssql->sql #t `(select (columns actors.firstname actors.lastname)
 | 
			
		||||
                     (from actors)))))
 | 
			
		||||
 | 
			
		||||
(test-group "dialect"
 | 
			
		||||
  (test "LIMIT and OFFSET"
 | 
			
		||||
    "SELECT * FROM integers LIMIT 10 OFFSET 100"
 | 
			
		||||
    (ssql->sql #t `(select (columns *) (from integers) (limit 10) (offset 100))))
 | 
			
		||||
 | 
			
		||||
  (test "random()"
 | 
			
		||||
    "SELECT * FROM widgets ORDER BY RANDOM()"
 | 
			
		||||
    (ssql->sql #t `(select (columns *) (from widgets) (order (random)))))
 | 
			
		||||
 | 
			
		||||
  (test "returning"
 | 
			
		||||
    "INSERT INTO widgets VALUES ('foo', 'bar') RETURNING id, name"
 | 
			
		||||
    (ssql->sql #t '(insert (into widgets) (values #("foo" "bar")) (returning id name))))
 | 
			
		||||
 | 
			
		||||
  (test "compose returning"
 | 
			
		||||
    '(insert (into widgets) (values #(1 2 3)) (returning id))
 | 
			
		||||
    (ssql-compose #t '(insert (into widgets) (values #(1 2 3))) '((returning id)))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(test-group "arrays"
 | 
			
		||||
  (test "literals"
 | 
			
		||||
    "SELECT ARRAY[1, 2, 3]"
 | 
			
		||||
    (ssql->sql #t '(select (array 1 2 3))))
 | 
			
		||||
 | 
			
		||||
  (test "contains operator"
 | 
			
		||||
    "SELECT (ARRAY['foo', 'bar'] @> ARRAY['bar'])"
 | 
			
		||||
    (ssql->sql #t '(select (@> (array "foo" "bar") (array "bar")))))
 | 
			
		||||
  
 | 
			
		||||
  (test "is contained operator"
 | 
			
		||||
    "SELECT (ARRAY['bar'] <@ ARRAY['foo', 'bar'])"
 | 
			
		||||
    (ssql->sql #t '(select (<@ (array "bar") (array "foo" "bar"))))))
 | 
			
		||||
    (use test postgresql foops))
 | 
			
		||||
  (chicken-5
 | 
			
		||||
    (import test (chicken load) (chicken platform))
 | 
			
		||||
    (repository-path (cons ".." (repository-path)))))
 | 
			
		||||
 | 
			
		||||
(load "test.scm")
 | 
			
		||||
(test-exit)
 | 
			
		||||
@ -0,0 +1,45 @@
 | 
			
		||||
(import postgresql foops ssql ssql-postgresql (chicken string))
 | 
			
		||||
 | 
			
		||||
(define *test-postgresql-translator* 
 | 
			
		||||
  (derive-object (*postgresql-translator* self super)
 | 
			
		||||
                 ((escape-string string)
 | 
			
		||||
                  (string-translate* string '(("'" . "''"))))))
 | 
			
		||||
 | 
			
		||||
(register-sql-engine! (lambda (x) (eq? x #t)) *test-postgresql-translator*)
 | 
			
		||||
 | 
			
		||||
(test-group "selects"
 | 
			
		||||
  (test "Simple query"
 | 
			
		||||
    "SELECT actors.firstname, actors.lastname FROM actors"
 | 
			
		||||
    (ssql->sql #t `(select (columns actors.firstname actors.lastname)
 | 
			
		||||
                     (from actors)))))
 | 
			
		||||
 | 
			
		||||
(test-group "dialect"
 | 
			
		||||
  (test "LIMIT and OFFSET"
 | 
			
		||||
    "SELECT * FROM integers LIMIT 10 OFFSET 100"
 | 
			
		||||
    (ssql->sql #t `(select (columns *) (from integers) (limit 10) (offset 100))))
 | 
			
		||||
 | 
			
		||||
  (test "random()"
 | 
			
		||||
    "SELECT * FROM widgets ORDER BY RANDOM()"
 | 
			
		||||
    (ssql->sql #t `(select (columns *) (from widgets) (order (random)))))
 | 
			
		||||
 | 
			
		||||
  (test "returning"
 | 
			
		||||
    "INSERT INTO widgets VALUES ('foo', 'bar') RETURNING id, name"
 | 
			
		||||
    (ssql->sql #t '(insert (into widgets) (values #("foo" "bar")) (returning id name))))
 | 
			
		||||
 | 
			
		||||
  (test "compose returning"
 | 
			
		||||
    '(insert (into widgets) (values #(1 2 3)) (returning id))
 | 
			
		||||
    (ssql-compose #t '(insert (into widgets) (values #(1 2 3))) '((returning id)))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(test-group "arrays"
 | 
			
		||||
  (test "literals"
 | 
			
		||||
    "SELECT ARRAY[1, 2, 3]"
 | 
			
		||||
    (ssql->sql #t '(select (array 1 2 3))))
 | 
			
		||||
 | 
			
		||||
  (test "contains operator"
 | 
			
		||||
    "SELECT (ARRAY['foo', 'bar'] @> ARRAY['bar'])"
 | 
			
		||||
    (ssql->sql #t '(select (@> (array "foo" "bar") (array "bar")))))
 | 
			
		||||
  
 | 
			
		||||
  (test "is contained operator"
 | 
			
		||||
    "SELECT (ARRAY['bar'] <@ ARRAY['foo', 'bar'])"
 | 
			
		||||
    (ssql->sql #t '(select (<@ (array "bar") (array "foo" "bar"))))))
 | 
			
		||||
					Loading…
					
					
				
		Reference in New Issue