[Help-smalltalk] [PATCH] postgres: Work on formatting Smalltalk types for PostgreSQL

[Holger Hans Peter Freyther]

DBD-PostgreSQL had various issues with >>#executeWithAll: on
prepared statements with various datatypes. Create a testcase
and make it configurable like it is done for MySQL.

>>#executeWithAll: didn't allow to insert a Smalltalk nil
into the database. Update the code formatting the query to
have a NULL pointer instead of a string with the value "NULL".

The FieldConverter is used differently between MySQL and
SQLite/PostgreSQL. On MySQL it may be used to help to format
a query (but no string escaping is done so it remains a
dangerous function) and on the other implementations it is
used for formatting the parameters when executing a prepared
statement.

On PostgreSQL the extra quotes lead to issues importing data.
First of all the FieldConverter never called the existing write
functions for Booleans and Integers. This is corrected by adding
True/False to the generic lookup table and special casing
integers. Then >>#writeBoolean:on: and >>#writeInteger:on: of
PGFieldConverter do not write quotes on the stream.

The last fix is with printing DateTime. On PostgreSQL one can
specify if a DATETIME column includes a timezone or not. When
inserting a DateTime this information should not be included
as PostgreSQL will do the right thing. The comparison of the
offset should have been with Duration zero but we can simply
omit this code.

2013-05-20  Holger Hans Peter Freyther  <address@hidden>

        * configure.ac: Add --enable-postgres-tests.
        * tests/atlocal.in: Add variables for PostgreSQL tests.
        * tests/local.at: Ignore the output on stderr for AT_PACKAGE_TEST.
        * tests/testsuite.at: Add the DBD-PostgreSQL package.

2013-05-20  Holger Hans Peter Freyther  <address@hidden>

        * FieldConverter.st: Add conversion for Integer, fix
        conversion for Boolean, Integer and DateTime.
        * Statement.st: Modify >>#executeWithAll:
        * Tests.st: Add the PostgresTestCase class.
        * package.xml: Add Test.st and sunit section.
---
 .travis.yml                               |    3 +-
 ChangeLog                                 |    7 +
 configure.ac                              |    7 +
 packages/dbd-postgresql/ChangeLog         |    8 +
 packages/dbd-postgresql/FieldConverter.st |   12 +-
 packages/dbd-postgresql/Makefile.frag     |    2 +-
 packages/dbd-postgresql/Statement.st      |    2 +-
 packages/dbd-postgresql/Tests.st          |  233 +++++++++++++++++++++++++++++
 packages/dbd-postgresql/package.xml       |    5 +
 packages/dbi/FieldConverter.st            |    8 +-
 tests/atlocal.in                          |    9 +-
 tests/local.at                            |    2 +-
 tests/testsuite.at                        |    1 +
 13 files changed, 284 insertions(+), 15 deletions(-)
 create mode 100644 packages/dbd-postgresql/Tests.st

diff --git a/.travis.yml b/.travis.yml
index 2737855..a1492b0 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -5,7 +5,8 @@ services:
  - mysql
 before_script:
  - mysql -e "create database gst_test; SET PASSWORD FOR 'root'@'localhost' = 
PASSWORD('gst'); FLUSH PRIVILEGES;"
+ - psql -c 'create database gst_test;' -U postgres
 before_install:
  - sudo apt-get update -qq
  - sudo apt-get install autotools-dev libreadline-dev libncurses-dev 
libsdl1.2-dev libsdl-image1.2-dev libsdl-mixer1.2-dev libsdl-sound1.2-dev 
libsdl-ttf2.0-dev libexpat1-dev freeglut3-dev libgmp3-dev libgdbm-dev 
libgtk2.0-dev libpq-dev libsigsegv-dev libffi-dev zip libsqlite3-dev unzip 
pkg-config libltdl-dev chrpath gawk libgnutls-dev automake autoconf libtool 
texinfo texlive
-script: autoreconf -vi && ./configure --enable-mysql-tests=root:gst:gst_test 
&& make && make check && make distcheck
+script: autoreconf -vi && ./configure --enable-mysql-tests=root:gst:gst_test 
--enable-postgres-tests=postgres:no:gst_test && make && make check && make 
distcheck
diff --git a/ChangeLog b/ChangeLog
index 8bc8710..abf839d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2013-05-20  Holger Hans Peter Freyther  <address@hidden>
+
+       * configure.ac: Add --enable-postgres-tests.
+       * tests/atlocal.in: Add variables for PostgreSQL tests.
+       * tests/local.at: Ignore the output on stderr for AT_PACKAGE_TEST.
+       * tests/testsuite.at: Add the DBD-PostgreSQL package.
+
 2013-05-18  Holger Hans Peter Freyther  <address@hidden>
 
        * gst-tool.c: Add --no-line-numbers to the gst-remote command.
diff --git a/configure.ac b/configure.ac
index df552c7..56c09cb 100644
--- a/configure.ac
+++ b/configure.ac
@@ -427,6 +427,13 @@ AC_MSG_RESULT($enable_mysql_tests)
 GST_PACKAGE_ENABLE([DBD-PostgreSQL], [dbd-postgresql],
    [GST_HAVE_LIB(pq, PQconnectdb)],
    [ac_cv_lib_pq_PQconnectdb])
+AC_MSG_CHECKING([whether to run PostgreSQL tests])
+AC_ARG_ENABLE(postgres-tests,
+[  --enable-postgres-tests=USER:PWD:DATABASE
+                          test PostgreSQL bindings [default=root:root:test]], ,
+[enable_postgres_tests=no])
+AC_SUBST(enable_postgres_tests)
+AC_MSG_RESULT($enable_postgres_tests)
 
 GST_PACKAGE_ENABLE([DBD-SQLite], [dbd-sqlite],
    [AC_CHECK_HEADER([sqlite3.h])
diff --git a/packages/dbd-postgresql/ChangeLog 
b/packages/dbd-postgresql/ChangeLog
index 794c1cc..616f31f 100644
--- a/packages/dbd-postgresql/ChangeLog
+++ b/packages/dbd-postgresql/ChangeLog
@@ -1,3 +1,11 @@
+2013-05-20  Holger Hans Peter Freyther  <address@hidden>
+
+       * FieldConverter.st: Add conversion for Integer, fix
+       conversion for Boolean, Integer and DateTime.
+       * Statement.st: Modify >>#executeWithAll:
+       * Tests.st: Add the PostgresTestCase class.
+       * package.xml: Add Test.st and sunit section.
+
 2011-10-26  Holger Hans Peter Freyther  <address@hidden>
 
        * Connection.st: Put PQConnection into 'private'.
diff --git a/packages/dbd-postgresql/FieldConverter.st 
b/packages/dbd-postgresql/FieldConverter.st
index ceb5178..ffbc1ba 100644
--- a/packages/dbd-postgresql/FieldConverter.st
+++ b/packages/dbd-postgresql/FieldConverter.st
@@ -38,19 +38,12 @@ FieldConverter subclass: PGFieldConverter [
 
     writeBoolean: aBoolean on: aStream [
         <category: 'converting-smalltalk'>
-        aStream nextPut: $'.
         aStream nextPut: (aBoolean ifTrue: [ $t ] ifFalse: [ $f ])
-        aStream nextPut: $'.
     ]
 
     writeDateTime: aDateTime on: aStream [
         <category: 'converting-smalltalk'>
-        aStream nextPutAll: 'timestamp '.
-       aDateTime offset = 0
-           ifFalse: [ aStream nextPutAll: 'with time zone ' ].
-        aStream nextPut: $'.
         aDateTime printOn: aStream.
-        aStream nextPut: $'.
     ]
 
     writeQuotedTime: aTime on: aStream [
@@ -60,4 +53,9 @@ FieldConverter subclass: PGFieldConverter [
             ifTrue: [ self writeDateTime: aTime on: aStream ]
             ifFalse: [ super writeTime: aTime on: aStream ]
     ]
+
+    writeInteger: anInteger on: aStream [
+        <category: 'converting-smalltalk'>
+        anInteger printOn: aStream.
+    ]
 ]
diff --git a/packages/dbd-postgresql/Makefile.frag 
b/packages/dbd-postgresql/Makefile.frag
index 3479b44..0e1fca4 100644
--- a/packages/dbd-postgresql/Makefile.frag
+++ b/packages/dbd-postgresql/Makefile.frag
@@ -1,5 +1,5 @@
 DBD-PostgreSQL_FILES = \
-packages/dbd-postgresql/Connection.st packages/dbd-postgresql/ResultSet.st 
packages/dbd-postgresql/Row.st packages/dbd-postgresql/ColumnInfo.st 
packages/dbd-postgresql/Statement.st packages/dbd-postgresql/Table.st 
packages/dbd-postgresql/TableColumnInfo.st 
packages/dbd-postgresql/FieldConverter.st
+packages/dbd-postgresql/Connection.st packages/dbd-postgresql/ResultSet.st 
packages/dbd-postgresql/Row.st packages/dbd-postgresql/ColumnInfo.st 
packages/dbd-postgresql/Statement.st packages/dbd-postgresql/Table.st 
packages/dbd-postgresql/TableColumnInfo.st 
packages/dbd-postgresql/FieldConverter.st packages/dbd-postgresql/Tests.st
 $(DBD-PostgreSQL_FILES):
 $(srcdir)/packages/dbd-postgresql/stamp-classes: $(DBD-PostgreSQL_FILES)
        touch $(srcdir)/packages/dbd-postgresql/stamp-classes
diff --git a/packages/dbd-postgresql/Statement.st 
b/packages/dbd-postgresql/Statement.st
index bd12ffb..4ad99f8 100644
--- a/packages/dbd-postgresql/Statement.st
+++ b/packages/dbd-postgresql/Statement.st
@@ -85,7 +85,7 @@ now the ability to execute commands with binding.'>
         "In PostgreSQL one can use $1 for binding parameters with the
          executeWithAll:. The parameters must be all strings."
         strings := params collect: [ :each |
-            each isString ifTrue: [each]
+            (each isString or: [each isNil]) ifTrue: [each]
                 ifFalse: [self connection fieldConverter printString: each]].
 
         res := PGResultSet new: (dbHandle exec: queryString with: strings).
diff --git a/packages/dbd-postgresql/Tests.st b/packages/dbd-postgresql/Tests.st
new file mode 100644
index 0000000..b66cb0e
--- /dev/null
+++ b/packages/dbd-postgresql/Tests.st
@@ -0,0 +1,233 @@
+"=====================================================================
+|
+|   PostgreSQL DBI driver unit tests
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2013 Free Software Foundation, Inc.
+| Written by Holger Hans Peter Freyther
+|
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+
+TestCase subclass: PostgresTestCase [
+    | conn |
+    <category: 'DBD-PostgreSQL-Tests'>
+    <comment: 'I test some basic Postgres binding classes'>
+
+    PostgresTestCase class >> schema [
+        ^'CREATE TABLE GSTTypes(
+                bigint BIGINT,
+                bigserial BIGSERIAL,
+                bit BIT,
+                bitvar BIT VARYING,
+                boolean BOOLEAN,
+                box BOX,
+                bytearray BYTEA,
+                character_var CHARACTER VARYING,
+                character CHARACTER,
+                cidr CIDR,
+                circle CIRCLE,
+                date DATE,
+                double DOUBLE PRECISION,
+                inet INET,
+                integer INTEGER,
+                interval INTERVAL,
+                line LINE,
+                lseg LSEG,
+                macaddr MACADDR,
+                money MONEY,
+                numeric NUMERIC,
+                path PATH,
+                point POINT,
+                polygen POLYGON,
+                real REAL,
+                smallint INT2,
+                serial SERIAL,
+                text TEXT,
+                time TIME,
+                time_tz TIME WITH TIME ZONE,
+                timestamp TIMESTAMP,
+                timestamp_tz TIMESTAMP WITH TIME ZONE,
+                tsquery TSQUERY,
+                tsvector TSVECTOR,
+                txid TXID_SNAPSHOT,
+                uuid UUID,
+                xml XML)'
+
+    ]
+
+    setUp [
+        | user pass db |
+        user := TestSuitesScripter variableAt: 'postgresuser' ifAbsent: [nil].
+        pass := TestSuitesScripter variableAt: 'postgrespassword' ifAbsent: 
[nil].
+        db := TestSuitesScripter variableAt: 'postgresdb' ifAbsent: ['gst'].
+
+        conn := DBI.Connection
+                connect: 'dbi:PostgreSQL:dbname=', db user: user password: 
pass.
+
+        "Drop and create some tables"
+        conn
+            do: 'DROP TABLE IF EXISTS GSTTypes CASCADE';
+            do: self class schema.
+    ]
+
+    tearDown [
+        conn close.
+    ]
+
+    testNull [
+        | statement res |
+
+        "I attempt to insert a NULL"
+        statement := conn prepare: 'INSERT INTO GSTTypes(bigint) VALUES($1)'.
+        res := statement executeWithAll: {nil}.
+        self deny: res isSelect.
+        self assert: res isDML.
+        self assert: res rowsAffected = 1.
+
+        res := conn do: 'SELECT * from GSTTypes WHERE bigint IS NULL'.
+        self assert: res isSelect.
+        self deny: res isDML.
+        self assert: res rowCount = 1.
+
+        self assert: (res next at: 'bigint') isNil.
+    ]
+
+    testInteger [
+        | statement res |
+
+        "I attempt to insert a number"
+        statement := conn prepare: 'INSERT INTO GSTTypes(integer) VALUES($1)'.
+        res := statement executeWithAll: {100}.
+        self deny: res isSelect.
+        self assert: res isDML.
+        self assert: res rowsAffected = 1.
+
+        res := conn do: 'SELECT * from GSTTypes WHERE integer = 100'.
+        self assert: res isSelect.
+        self deny: res isDML.
+        self assert: res rowCount = 1.
+
+        self assert: (res next at: 'integer')  = 100.
+    ]
+
+    testDateTime [
+        | statement res now now_utc row |
+
+        "Pick a date and time with timezone"
+        now := DateTime now
+                offset: (Duration hours: 3).
+
+        statement := conn prepare:
+                    'INSERT INTO GSTTypes(timestamp, timestamp_tz) 
VALUES($1,$2)'.
+        res := statement executeWithAll: {now. now}.
+        self deny: res isSelect.
+        self assert: res isDML.
+        self assert: res rowsAffected = 1.
+
+        res := conn do: 'SELECT * from GSTTypes'.
+        self assert: res isSelect.
+        self deny: res isDML.
+        self assert: res rowCount = 1.
+
+        row := res next.
+
+        "Check that Postgres just dropped the offset from the timestamp we 
passed"
+        self assert: (row at: 'timestamp') offset = Duration zero.
+        self assert: (row at: 'timestamp') = (now offset: Duration zero).
+
+        "Check that we can read the time back as it should be."
+        self assert: (row at: 'timestamp_tz') = now.
+    ]
+
+    testBoolean [
+        | statement res row |
+        statement := conn prepare:
+                    'INSERT INTO GSTTypes(boolean,integer) VALUES($1,$2)'.
+
+        "Insert a true"
+        res := statement executeWithAll: {true. 10}.
+        self deny: res isSelect.
+        self assert: res isDML.
+        self assert: res rowsAffected = 1.
+
+        "Insert a false"
+        res := statement executeWithAll: {false. 20}.
+        self deny: res isSelect.
+        self assert: res isDML.
+        self assert: res rowsAffected = 1.
+
+        res := conn do: 'SELECT * from GSTTypes ORDER BY integer'.
+        self assert: res isSelect.
+        self deny: res isDML.
+        self assert: res rowCount = 2.
+
+        row := res next.
+        self assert: (row at: 'integer') = 10.
+        self assert: (row at: 'boolean').
+
+        row := res next.
+        self assert: (row at: 'integer') = 20.
+        self deny: (row at: 'boolean').
+    ]
+
+    testTime [
+        | statement res now |
+
+        now := Time now.
+
+        statement := conn prepare: 'INSERT INTO GSTTypes(time) VALUES($1)'.
+        res := statement executeWithAll: {now}.
+        self deny: res isSelect.
+        self assert: res isDML.
+        self assert: res rowsAffected = 1.
+
+        res := conn do: 'SELECT * from GSTTypes'.
+        self assert: res isSelect.
+        self deny: res isDML.
+        self assert: res rowCount = 1.
+
+        self assert: (res next at: 'time') = now.
+    ]
+
+    testTimeTz [
+        "GST doesn't have a Timezone on the Time"
+        | statement res now |
+
+        now := Time now.
+        statement := conn prepare: 'INSERT INTO GSTTypes(time_tz) VALUES($1)'.
+        res := statement executeWithAll: {now}.
+        self deny: res isSelect.
+        self assert: res isDML.
+        self assert: res rowsAffected = 1.
+
+        res := conn do: 'SELECT * from GSTTypes'.
+        self assert: res isSelect.
+        self deny: res isDML.
+        self assert: res rowCount = 1.
+
+        self assert: (res next at: 'time_tz') = now.
+    ]
+]
diff --git a/packages/dbd-postgresql/package.xml 
b/packages/dbd-postgresql/package.xml
index 36d6a29..280dcb3 100644
--- a/packages/dbd-postgresql/package.xml
+++ b/packages/dbd-postgresql/package.xml
@@ -12,4 +12,9 @@
   <filein>Table.st</filein>
   <filein>TableColumnInfo.st</filein>
   <filein>FieldConverter.st</filein>
+
+  <test>
+    <sunit>DBI.PostgreSQL.PostgresTestCase</sunit>
+    <filein>Tests.st</filein>
+  </test>
 </package>
diff --git a/packages/dbi/FieldConverter.st b/packages/dbi/FieldConverter.st
index 819852a..8292fcd 100644
--- a/packages/dbi/FieldConverter.st
+++ b/packages/dbi/FieldConverter.st
@@ -133,7 +133,9 @@ Object subclass: FieldConverter [
         | aSelector |
        aValue isNil ifTrue: [ aStream nextPutAll: 'NULL'. ^self ].
         aSelector := converterSelectors at: aValue class
-                    ifAbsent: [ #defaultConvert:on: ].
+                    ifAbsent: [ aValue isInteger
+                                    ifTrue: [#writeInteger:on:]
+                                    ifFalse: [#defaultConvert:on:]].
         self
             perform: aSelector
             with: aValue
@@ -163,12 +165,12 @@ Object subclass: FieldConverter [
         <category: 'private-initialize'>
         converterSelectors := IdentityDictionary new.
         converterSelectors
-            at: Boolean put: #writeBoolean:on:;
+            at: True put: #writeBoolean:on:;
+            at: False put: #writeBoolean:on:;
             at: FloatD put: #writeFloat:on:;
             at: FloatE put: #writeFloat:on:;
             at: FloatQ put: #writeFloat:on:;
             at: Fraction put: #writeFloat:on:;
-            at: Integer put: #writeInteger:on:;
             at: Date put: #writeQuotedDate:on:;
             at: DateTime put: #writeDateTime:on:;
             at: Time put: #writeQuotedTime:on:
diff --git a/tests/atlocal.in b/tests/atlocal.in
index 05f8eff..9f80fc4 100644
--- a/tests/atlocal.in
+++ b/tests/atlocal.in
@@ -1,4 +1,5 @@
 enable_mysql_tests='@enable_mysql_tests@'
+enable_postgres_tests='@enable_postgres_tests@'
 host='@host@'
 TIMEOUT='@TIMEOUT@'
 mysqlvars=`echo $enable_mysql_tests | awk '
@@ -8,4 +9,10 @@ mysqlvars=`echo $enable_mysql_tests | awk '
   length($2) { printf "mysqlpassword='\''%s'\'' ", $2 }
   length($3) { printf "mysqldb='\''%s'\'' ", $3 }
 ' `
-
+postgresvars=`echo $enable_postgres_tests | awk '
+  BEGIN { FS=":" }
+  /^(yes|no)$/ { next }
+  length($1) { printf "postgresuser='\''%s'\'' ", $1 }
+  length($2) { printf "postgrespassword='\''%s'\'' ", $2 }
+  length($3) { printf "postgresdb='\''%s'\'' ", $3 }
+' `
diff --git a/tests/local.at b/tests/local.at
index 49f9111..9297a06 100755
--- a/tests/local.at
+++ b/tests/local.at
@@ -47,7 +47,7 @@ m4_define([AT_PACKAGE_TEST], [
   AT_KEYWORDS([m4_if([$1], [SUnit], [], [$1 ])SUnit])
   $2
   m4_ifval([$4], [AT_CHECK([$4 || exit 77])])
-  AT_CHECK_GST([-f $abs_top_srcdir/scripts/Test.st --verbose $3 -p $1], [], 
[], [ignore])
+  AT_CHECK_GST([-f $abs_top_srcdir/scripts/Test.st --verbose $3 -p $1], [], 
[], [ignore], [ignore])
   AT_CLEANUP
 ])
 
diff --git a/tests/testsuite.at b/tests/testsuite.at
index d661b3d..8cd2b1c 100644
--- a/tests/testsuite.at
+++ b/tests/testsuite.at
@@ -149,6 +149,7 @@ AT_PACKAGE_TEST([Announcements])
 AT_PACKAGE_TEST([Complex])
 AT_PACKAGE_TEST([Continuations])
 AT_PACKAGE_TEST([DBD-MySQL], [], [$mysqlvars], [test "$enable_mysql_tests" != 
no])
+AT_PACKAGE_TEST([DBD-PostgreSQL], [], [$postgresvars], [test 
"$enable_postgres_tests" != no])
 AT_OPTIONAL_PACKAGE_TEST([DBD-SQLite])
 AT_PACKAGE_TEST([DebugTools])
 AT_PACKAGE_TEST([DhbNumericalMethods])
-- 
1.7.10.4