Merge branch 'master' of git://factorcode.org/git/factor

extra/cairo/cairo.factor

@@ -14,11 +14,14 @@ IN: cairo
 
 << "cairo" {
         { [ win32? ] [ "cairo.dll" ] }
-        { [ macosx? ] [ "libcairo.dylib" ] }
+        ! { [ macosx? ] [ "libcairo.dylib" ] }
+        { [ macosx? ] [ "/opt/local/lib/libcairo.dylib" ] }
         { [ unix? ] [ "libcairo.so.2" ] }
   } cond "cdecl" add-library >>
 
-! cairo_status_t
+LIBRARY: cairo
+
+TYPEDEF: int cairo_status_t
 C-ENUM:
     CAIRO_STATUS_SUCCESS
     CAIRO_STATUS_NO_MEMORY
@@ -45,12 +48,12 @@ C-ENUM:
     CAIRO_STATUS_CLIP_NOT_REPRESENTABLE
 ;
 
-! cairo_content_t
+TYPEDEF: int cairo_content_t
 : CAIRO_CONTENT_COLOR HEX: 1000 ;
 : CAIRO_CONTENT_ALPHA HEX: 2000 ;
 : CAIRO_CONTENT_COLOR_ALPHA HEX: 3000 ;
 
-! cairo_operator_t
+TYPEDEF: int cairo_operator_t
 C-ENUM:
     CAIRO_OPERATOR_CLEAR
     CAIRO_OPERATOR_SOURCE
@@ -68,34 +71,34 @@ C-ENUM:
     CAIRO_OPERATOR_SATURATE
 ;
 
-! cairo_line_cap_t
+TYPEDEF: int cairo_line_cap_t
 C-ENUM:
     CAIRO_LINE_CAP_BUTT
     CAIRO_LINE_CAP_ROUND
     CAIRO_LINE_CAP_SQUARE
 ;
 
-! cair_line_join_t
+TYPEDEF: int cair_line_join_t
 C-ENUM:
     CAIRO_LINE_JOIN_MITER
     CAIRO_LINE_JOIN_ROUND
     CAIRO_LINE_JOIN_BEVEL
 ;
 
-! cairo_fill_rule_t
+TYPEDEF: int cairo_fill_rule_t
 C-ENUM:
     CAIRO_FILL_RULE_WINDING
     CAIRO_FILL_RULE_EVEN_ODD
 ;
 
-! cairo_font_slant_t
+TYPEDEF: int cairo_font_slant_t
 C-ENUM:
     CAIRO_FONT_SLANT_NORMAL
     CAIRO_FONT_SLANT_ITALIC
     CAIRO_FONT_SLANT_OBLIQUE
 ;
 
-! cairo_font_weight_t
+TYPEDEF: int cairo_font_weight_t
 C-ENUM:
     CAIRO_FONT_WEIGHT_NORMAL
     CAIRO_FONT_WEIGHT_BOLD
@@ -159,7 +162,7 @@ C-STRUCT: cairo_matrix_t
         { "double" "x0" }
         { "double" "y0" } ;
 
-! cairo_format_t
+TYPEDEF: int cairo_format_t
 C-ENUM:
     CAIRO_FORMAT_ARGB32
     CAIRO_FORMAT_RGB24
@@ -167,7 +170,7 @@ C-ENUM:
     CAIRO_FORMAT_A1
 ;
 
-! cairo_antialias_t
+TYPEDEF: int cairo_antialias_t
 C-ENUM:
     CAIRO_ANTIALIAS_DEFAULT
     CAIRO_ANTIALIAS_NONE
@@ -175,7 +178,7 @@ C-ENUM:
     CAIRO_ANTIALIAS_SUBPIXEL
 ;
 
-! cairo_subpixel_order_t
+TYPEDEF: int cairo_subpixel_order_t
 C-ENUM:
     CAIRO_SUBPIXEL_ORDER_DEFAULT
     CAIRO_SUBPIXEL_ORDER_RGB
@@ -184,7 +187,7 @@ C-ENUM:
     CAIRO_SUBPIXEL_ORDER_VBGR
 ;
 
-! cairo_hint_style_t
+TYPEDEF: int cairo_hint_style_t
 C-ENUM:
     CAIRO_HINT_STYLE_DEFAULT
     CAIRO_HINT_STYLE_NONE
@@ -193,7 +196,7 @@ C-ENUM:
     CAIRO_HINT_STYLE_FULL
 ;
 
-! cairo_hint_metrics_t
+TYPEDEF: int cairo_hint_metrics_t
 C-ENUM:
     CAIRO_HINT_METRICS_DEFAULT
     CAIRO_HINT_METRICS_OFF
@@ -420,7 +423,11 @@ C-ENUM:
 : cairo_get_font_matrix ( cairo_t cairo_matrix_t -- )
         "void" "cairo" "cairo_get_font_matrix" [ "cairo_t*" "cairo_matrix_t*" ] alien-invoke ;
 
-
+FUNCTION: uchar* cairo_image_surface_get_data ( cairo_surface_t* surface ) ;
+FUNCTION: cairo_format_t cairo_image_surface_get_format ( cairo_surface_t* surface ) ;
+FUNCTION: int cairo_image_surface_get_width ( cairo_surface_t* surface ) ;
+FUNCTION: int cairo_image_surface_get_height ( cairo_surface_t* surface ) ;
+FUNCTION: int cairo_image_surface_get_stride ( cairo_surface_t* surface ) ;
 
 ! Cairo pdf
 
@@ -437,3 +444,16 @@ C-ENUM:
 
 : cairo_pdf_surface_set_size ( surface width height -- )
   "void" "cairo" "cairo_pdf_surface_set_size" [ "void*" "double" "double" ] alien-invoke ;
+
+! Cairo png
+
+TYPEDEF: void* cairo_write_func_t
+TYPEDEF: void* cairo_read_func_t
+
+FUNCTION: cairo_surface_t* cairo_image_surface_create_from_png ( char* filename ) ;
+
+FUNCTION: cairo_surface_t* cairo_image_surface_create_from_png_stream ( cairo_read_func_t read_func, void* closure ) ;
+
+FUNCTION: cairo_status_t cairo_surface_write_to_png ( cairo_surface_t* surface, char* filename ) ;
+
+FUNCTION: cairo_status_t cairo_surface_write_to_png_stream ( cairo_surface_t* surface, cairo_write_func_t write_func, void* closure ) ;

extra/crypto/rc4/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

extra/crypto/rc4/rc4.factor

@@ -1,39 +0,0 @@
-USING: kernel math sequences namespaces ;
-IN: crypto.rc4
-
-! http://en.wikipedia.org/wiki/RC4_%28cipher%29
-
-<PRIVATE
-
-SYMBOL: i
-SYMBOL: j
-SYMBOL: s
-SYMBOL: key
-SYMBOL: l
-
-! key scheduling algorithm, initialize s
-: ksa ( -- )
-    256 [ ] map s set
-    0 j set
-    256 [
-        dup s get nth j get + over l get mod key get nth + 255 bitand j set
-        dup j get s get exchange drop
-    ] each ;
-
-: generate ( -- n )
-    i get 1+ 255 bitand i set
-    j get i get s get nth + 255 bitand j set
-    i get j get s get exchange
-    i get s get nth j get s get nth + 255 bitand s get nth ;
-
-PRIVATE>
-
-: rc4 ( key -- )
-    [
-        [ key set ] keep
-        length l set
-        ksa
-        0 i set
-        0 j set
-    ] with-scope ;
-

extra/db/db.factor

@@ -20,8 +20,7 @@ GENERIC: db-open ( db -- )
 HOOK: db-close db ( handle -- )
 : make-db ( seq class -- db ) construct-empty make-db* ;
 
-: dispose-statements ( seq -- )
+: dispose-statements ( seq -- ) [ dispose drop ] assoc-each ;
-    [ dispose drop ] assoc-each ;
 
 : dispose-db ( db -- ) 
     dup db [
@@ -46,8 +45,8 @@ GENERIC: bind-tuple ( tuple statement -- )
 GENERIC: query-results ( query -- result-set )
 GENERIC: #rows ( result-set -- n )
 GENERIC: #columns ( result-set -- n )
-GENERIC# row-column 1 ( result-set n -- obj )
+GENERIC# row-column 1 ( result-set column -- obj )
-GENERIC# row-column-typed 1 ( result-set n -- sql )
+GENERIC# row-column-typed 1 ( result-set column -- sql )
 GENERIC: advance-row ( result-set -- )
 GENERIC: more-rows? ( result-set -- ? )
 

extra/db/postgresql/ffi/ffi.factor

@@ -270,7 +270,8 @@ FUNCTION: char* PQcmdStatus ( PGresult* res ) ;
 FUNCTION: char* PQoidStatus ( PGresult* res ) ;
 FUNCTION: Oid   PQoidValue ( PGresult* res ) ;
 FUNCTION: char* PQcmdTuples ( PGresult* res ) ;
-FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
+! FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
+FUNCTION: void* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
 FUNCTION: int   PQgetlength ( PGresult* res, int tup_num, int field_num ) ;
 FUNCTION: int   PQgetisnull ( PGresult* res, int tup_num, int field_num ) ;
 
@@ -297,8 +298,8 @@ FUNCTION: size_t PQescapeStringConn ( PGconn* conn,
 FUNCTION: uchar* PQescapeByteaConn ( PGconn* conn,
                                     char* from, size_t length,
                                     size_t* to_length ) ;
-FUNCTION: uchar* PQunescapeBytea ( uchar* strtext,
+FUNCTION: void* PQunescapeBytea ( uchar* strtext, size_t* retbuflen ) ;
-                size_t* retbuflen ) ;
+! FUNCTION: uchar* PQunescapeBytea ( uchar* strtext, size_t* retbuflen ) ;
 ! These forms are deprecated!
 FUNCTION: size_t PQescapeString ( void* to, char* from, size_t length ) ;
 FUNCTION: uchar* PQescapeBytea ( uchar* bintext, size_t binlen,
@@ -346,3 +347,23 @@ FUNCTION: int    PQdsplen ( uchar* s, int encoding ) ;
 
 ! Get encoding id from environment variable PGCLIENTENCODING
 FUNCTION: int    PQenv2encoding ( ) ;
+
+! From git, include/catalog/pg_type.h
+: BOOL-OID 16 ; inline
+: BYTEA-OID 17 ; inline
+: CHAR-OID 18 ; inline
+: NAME-OID 19 ; inline
+: INT8-OID 20 ; inline
+: INT2-OID 21 ; inline
+: INT4-OID 23 ; inline
+: TEXT-OID 23 ; inline
+: OID-OID 26 ; inline
+: FLOAT4-OID 700 ; inline
+: FLOAT8-OID 701 ; inline
+: VARCHAR-OID 1043 ; inline
+: DATE-OID 1082 ; inline
+: TIME-OID 1083 ; inline
+: TIMESTAMP-OID 1114 ; inline
+: TIMESTAMPTZ-OID 1184 ; inline
+: INTERVAL-OID 1186 ; inline
+: NUMERIC-OID 1700 ; inline

extra/db/postgresql/lib/lib.factor

@@ -2,7 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays continuations db io kernel math namespaces
 quotations sequences db.postgresql.ffi alien alien.c-types
-db.types tools.walker ascii splitting ;
+db.types tools.walker ascii splitting math.parser
+combinators combinators.cleave libc shuffle calendar.format
+byte-arrays destructors prettyprint new-slots accessors
+strings serialize io.encodings.binary io.streams.byte-array ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
@@ -38,13 +41,130 @@ IN: db.postgresql.lib
         dup postgresql-result-error-message swap PQclear throw
     ] unless ;
 
+: type>oid ( symbol -- n )
+    dup array? [ first ] when
+    {
+        { BLOB [ BYTEA-OID ] }
+        { FACTOR-BLOB [ BYTEA-OID ] }
+        [ drop 0 ]
+    } case ;
+
+: type>param-format ( symbol -- n )
+    dup array? [ first ] when
+    {
+        { BLOB [ 1 ] }
+        { FACTOR-BLOB [ 1 ] }
+        [ drop 0 ]
+    } case ;
+
+: param-types ( statement -- seq )
+    statement-in-params
+    [ sql-spec-type type>oid ] map
+    >c-uint-array ;
+
+: malloc-byte-array/length
+    [ malloc-byte-array dup free-always ] [ length ] bi ;
+    
+
+: param-values ( statement -- seq seq2 )
+    [ statement-bind-params ]
+    [ statement-in-params ] bi
+    [
+        sql-spec-type {
+            { FACTOR-BLOB [
+                dup [
+                    binary [ serialize ] with-byte-writer
+                    malloc-byte-array/length ] [ 0 ] if ] }
+            { BLOB [
+                dup [ malloc-byte-array/length ] [ 0 ] if ] }
+            [
+                drop number>string* dup [
+                    malloc-char-string dup free-always
+                ] when 0
+            ]
+        } case 2array
+    ] 2map flip dup empty? [
+        drop f f
+    ] [
+        first2 [ >c-void*-array ] [ >c-uint-array ] bi*
+    ] if ;
+
+: param-formats ( statement -- seq )
+    statement-in-params
+    [ sql-spec-type type>param-format ] map
+    >c-uint-array ;
+
 : do-postgresql-bound-statement ( statement -- res )
+    [
         >r db get db-handle r>
-    [ statement-sql ] keep
+        {
-    [ statement-bind-params length f ] keep
+            [ statement-sql ]
-    statement-bind-params
+            [ statement-bind-params length ]
-    [ number>string* malloc-char-string ] map >c-void*-array
+            [ param-types ]
-    f f 0 PQexecParams
+            [ param-values ]
-    dup postgresql-result-ok? [
+            [ param-formats ]
+        } cleave
+        0 PQexecParams dup postgresql-result-ok? [
             dup postgresql-result-error-message swap PQclear throw
-    ] unless ;
+        ] unless
+    ] with-destructors ;
+
+: pq-get-is-null ( handle row column -- ? )
+    PQgetisnull 1 = ;
+
+: pq-get-string ( handle row column -- obj )
+    3dup PQgetvalue alien>char-string
+    dup "" = [ >r pq-get-is-null f r> ? ] [ 3nip ] if ;
+
+: pq-get-number ( handle row column -- obj )
+    pq-get-string dup [ string>number ] when ;
+
+TUPLE: postgresql-malloc-destructor alien ;
+C: <postgresql-malloc-destructor> postgresql-malloc-destructor
+
+M: postgresql-malloc-destructor dispose ( obj -- )
+    alien>> PQfreemem ;
+
+: postgresql-free-always ( alien -- )
+    <postgresql-malloc-destructor> add-always-destructor ;
+
+: pq-get-blob ( handle row column -- obj/f )
+    [ PQgetvalue ] 3keep 3dup PQgetlength
+    dup 0 > [
+        3nip
+        [
+            memory>byte-array >string
+            0 <uint>
+            [
+                PQunescapeBytea dup zero? [
+                    postgresql-result-error-message throw
+                ] [
+                    dup postgresql-free-always
+                ] if
+            ] keep
+            *uint memory>byte-array
+        ] with-destructors 
+    ] [
+        drop pq-get-is-null nip [ f ] [ B{ } clone ] if
+    ] if ;
+
+: postgresql-column-typed ( handle row column type -- obj )
+    dup array? [ first ] when
+    {
+        { +native-id+ [ pq-get-number ] }
+        { INTEGER [ pq-get-number ] }
+        { BIG-INTEGER [ pq-get-number ] }
+        { DOUBLE [ pq-get-number ] }
+        { TEXT [ pq-get-string ] }
+        { VARCHAR [ pq-get-string ] }
+        { DATE [ pq-get-string dup [ ymd>timestamp ] when ] }
+        { TIME [ pq-get-string dup [ hms>timestamp ] when ] }
+        { TIMESTAMP [ pq-get-string dup [ ymdhms>timestamp ] when ] }
+        { DATETIME [ pq-get-string dup [ ymdhms>timestamp ] when ] }
+        { BLOB [ pq-get-blob ] }
+        { FACTOR-BLOB [
+            pq-get-blob
+            dup [ binary [ deserialize ] with-byte-reader ] when ] }
+        [ no-sql-type ]
+    } case ;
+    ! PQgetlength PQgetisnull

extra/db/postgresql/postgresql.factor

@@ -4,7 +4,8 @@ USING: arrays assocs alien alien.syntax continuations io
 kernel math math.parser namespaces prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
-combinators sequences.lib classes locals words tools.walker ;
+combinators sequences.lib classes locals words tools.walker
+combinators.cleave namespaces.lib ;
 IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@@ -53,11 +54,12 @@ M: postgresql-result-set #rows ( result-set -- n )
 M: postgresql-result-set #columns ( result-set -- n )
     result-set-handle PQnfields ;
 
-M: postgresql-result-set row-column ( result-set n -- obj )
+M: postgresql-result-set row-column ( result-set column -- obj )
-    >r dup result-set-handle swap result-set-n r> PQgetvalue ;
+    >r dup result-set-handle swap result-set-n r> pq-get-string ;
 
-M: postgresql-result-set row-column-typed ( result-set n type -- obj )
+M: postgresql-result-set row-column-typed ( result-set column -- obj )
-    >r row-column r> sql-type>factor-type ;
+    dup pick result-set-out-params nth sql-spec-type
+    >r >r [ result-set-handle ] [ result-set-n ] bi r> r> postgresql-column-typed ;
 
 M: postgresql-statement query-results ( query -- result-set )
     dup statement-bind-params [
@@ -236,10 +238,13 @@ M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
 
         " from " 0% 0%
         [ sql-spec-slot-name swap get-slot-named ] with subset
+        dup empty? [
+            drop
+        ] [
             " where " 0%
-        [ ", " 0% ]
+            [ " and " 0% ]
             [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
-        ";" 0%
+        ] if ";" 0%
     ] postgresql-make ;
 
 M: postgresql-db type-table ( -- hash )
@@ -249,7 +254,12 @@ M: postgresql-db type-table ( -- hash )
         { VARCHAR "varchar" }
         { INTEGER "integer" }
         { DOUBLE "real" }
+        { DATE "date" }
+        { TIME "time" }
+        { DATETIME "timestamp" }
         { TIMESTAMP "timestamp" }
+        { BLOB "bytea" }
+        { FACTOR-BLOB "bytea" }
     } ;
 
 M: postgresql-db create-type-table ( -- hash )

extra/db/sqlite/lib/lib.factor

@@ -3,7 +3,8 @@
 USING: alien.c-types arrays assocs kernel math math.parser
 namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
-io.streams.byte-array byte-arrays io.encodings.binary ;
+io.streams.byte-array byte-arrays io.encodings.binary
+tools.walker ;
 IN: db.sqlite.lib
 
 : sqlite-error ( n -- * )
@@ -127,9 +128,9 @@ IN: db.sqlite.lib
         { +native-id+ [ sqlite3_column_int64 ] }
         { INTEGER [ sqlite3_column_int ] }
         { BIG-INTEGER [ sqlite3_column_int64 ] }
+        { DOUBLE [ sqlite3_column_double ] }
         { TEXT [ sqlite3_column_text ] }
         { VARCHAR [ sqlite3_column_text ] }
-        { DOUBLE [ sqlite3_column_double ] }
         { DATE [ sqlite3_column_text dup [ ymd>timestamp ] when ] }
         { TIME [ sqlite3_column_text dup [ hms>timestamp ] when ] }
         { TIMESTAMP [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
@@ -137,7 +138,7 @@ IN: db.sqlite.lib
         { BLOB [ sqlite-column-blob ] }
         { FACTOR-BLOB [
             sqlite-column-blob
-            binary [ deserialize ] with-byte-reader
+            dup [ binary [ deserialize ] with-byte-reader ] when
         ] }
         ! { NULL [ 2drop f ] }
         [ no-sql-type ]

extra/db/tuples/tuples-tests.factor

@@ -3,10 +3,12 @@
 USING: io.files kernel tools.test db db.tuples
 db.types continuations namespaces math
 prettyprint tools.walker db.sqlite calendar
-math.intervals ;
+math.intervals db.postgresql ;
 IN: db.tuples.tests
 
-TUPLE: person the-id the-name the-number the-real ts date time blob ;
+TUPLE: person the-id the-name the-number the-real
+ts date time blob factor-blob ;
+
 : <person> ( name age real ts date time blob -- person )
     {
         set-person-the-name
@@ -16,9 +18,10 @@ TUPLE: person the-id the-name the-number the-real ts date time blob ;
         set-person-date
         set-person-time
         set-person-blob
+        set-person-factor-blob
     } person construct ;
 
-: <assigned-person> ( id name age real ts date time blob -- person )
+: <assigned-person> ( id name age real ts date time blob factor-blob -- person )
     <person> [ set-person-the-id ] keep ;
 
 SYMBOL: person1
@@ -82,6 +85,23 @@ SYMBOL: person4
         }
     ] [ T{ person f 3 } select-tuple ] unit-test
 
+    [ ] [ person4 get insert-tuple ] unit-test
+    [
+        T{
+            person
+            f
+            4
+            "eddie"
+            10
+            3.14
+            T{ timestamp f 2008 3 5 16 24 11 0 }
+            T{ timestamp f 2008 11 22 f f f f }
+            T{ timestamp f f f f 12 34 56 f }
+            f
+            H{ { 1 2 } { 3 4 } { 5 "lol" } }
+        }
+    ] [ T{ person f 4 } select-tuple ] unit-test
+
     [ ] [ person drop-table ] unit-test ;
 
 : make-native-person-table ( -- )
@@ -102,10 +122,12 @@ SYMBOL: person4
         { "date" "D" DATE }
         { "time" "T" TIME }
         { "blob" "B" BLOB }
+        { "factor-blob" "FB" FACTOR-BLOB }
     } define-persistent
-    "billy" 10 3.14 f f f f <person> person1 set
+    "billy" 10 3.14 f f f f f <person> person1 set
-    "johnny" 10 3.14 f f f f <person> person2 set
+    "johnny" 10 3.14 f f f f f <person> person2 set
-    "teddy" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" B{ 115 116 111 114 101 105 110 97 98 108 111 98 } <person> person3 set ;
+    "teddy" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" B{ 115 116 111 114 101 105 110 97 98 108 111 98 } f <person> person3 set
+    "eddie" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" f H{ { 1 2 } { 3 4 } { 5 "lol" } } <person> person4 set ;
 
 : assigned-person-schema ( -- )
     person "PERSON"
@@ -118,10 +140,12 @@ SYMBOL: person4
         { "date" "D" DATE }
         { "time" "T" TIME }
         { "blob" "B" BLOB }
+        { "factor-blob" "FB" FACTOR-BLOB }
     } define-persistent
-    1 "billy" 10 3.14 f f f f <assigned-person> person1 set
+    1 "billy" 10 3.14 f f f f f <assigned-person> person1 set
-    2 "johnny" 10 3.14 f f f f <assigned-person> person2 set
+    2 "johnny" 10 3.14 f f f f f <assigned-person> person2 set
-    3 "teddy" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" B{ 115 116 111 114 101 105 110 97 98 108 111 98 } <assigned-person> person3 set ;
+    3 "teddy" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" B{ 115 116 111 114 101 105 110 97 98 108 111 98 } f <assigned-person> person3 set
+    4 "eddie" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" f H{ { 1 2 } { 3 4 } { 5 "lol" } } <assigned-person> person4 set ;
 
 TUPLE: paste n summary author channel mode contents timestamp annotations ;
 TUPLE: annotation n paste-id summary author mode contents ;
@@ -161,12 +185,15 @@ TUPLE: annotation n paste-id summary author mode contents ;
 : test-sqlite ( quot -- )
     >r "tuples-test.db" temp-file sqlite-db r> with-db ;
 
-! : test-postgresql ( -- )
+: test-postgresql ( -- )
-!    >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
+>r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
 
 [ native-person-schema test-tuples ] test-sqlite
 [ assigned-person-schema test-tuples ] test-sqlite
 
+[ native-person-schema test-tuples ] test-postgresql
+[ assigned-person-schema test-tuples ] test-postgresql
+
 TUPLE: serialize-me id data ;
 
 : test-serialize ( -- )
@@ -183,7 +210,8 @@ TUPLE: serialize-me id data ;
         { T{ serialize-me f 1 H{ { 1 2 } } } }
     ] [ T{ serialize-me f 1 } select-tuples ] unit-test ;
 
-! [ test-serialize ] test-sqlite
+[ test-serialize ] test-sqlite
+[ test-serialize ] test-postgresql
 
 TUPLE: exam id name score ;