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

diff --combined basis/db/db.factor
index 5b159d0ea19f4859426b587fbaeffb313680500d,87bf21d26139e431bccce30bb5a2686713925abf..5b159d0ea19f4859426b587fbaeffb313680500d
mode 100755,100644..100644
--- 1/basis/db/db.factor
--- 2/basis/db/db.factor
+++ b/basis/db/db.factor
@@@ -2,7 -2,7 +2,7 @@@
  ! See http://factorcode.org/license.txt for BSD license.
  USING: arrays assocs classes continuations destructors kernel math
  namespaces sequences classes.tuple words strings
 -tools.walker accessors combinators ;
 +tools.walker accessors combinators fry ;
  IN: db
  
  TUPLE: db
@@@ -17,6 -17,10 +17,6 @@@
          H{ } clone >>update-statements
          H{ } clone >>delete-statements ; inline
  
 -GENERIC: make-db* ( object db -- db )
 -
 -: make-db ( object class -- db ) new-db make-db* ;
 -
  GENERIC: db-open ( db -- db )
  HOOK: db-close db ( handle -- )
  
@@@ -107,9 -111,10 +107,9 @@@ M: object execute-statement* ( statemen
  : query-map ( statement quot -- seq )
      accumulator [ query-each ] dip { } like ; inline
  
 -: with-db ( seq class quot -- )
 -    [ make-db db-open db ] dip
 -    [ db get swap [ drop ] prepose with-disposal ] curry with-variable ;
 -    inline
 +: with-db ( db quot -- )
 +    [ db-open db ] dip
 +    '[ db get [ drop @ ] with-disposal ] with-variable ; inline
  
  : default-query ( query -- result-set )
      query-results [ [ sql-row ] query-map ] with-disposal ;

diff --combined basis/db/postgresql/postgresql.factor
index 08df25c13a9ff27e2950cf6f5d99cb5a7956ca9c,28548d1260efe456c23820552e89fa9fe1c05d44..08df25c13a9ff27e2950cf6f5d99cb5a7956ca9c
mode 100755,100644..100644
--- 1/basis/db/postgresql/postgresql.factor
--- 2/basis/db/postgresql/postgresql.factor
+++ b/basis/db/postgresql/postgresql.factor
@@@ -10,24 -10,28 +10,24 @@@ USE: tools.walke
  IN: db.postgresql
  
  TUPLE: postgresql-db < db
 -    host port pgopts pgtty db user pass ;
 +    host port pgopts pgtty database username password ;
 +
 +: <postgresql-db> ( -- postgresql-db )
 +    postgresql-db new-db ;
  
  TUPLE: postgresql-statement < statement ;
  
  TUPLE: postgresql-result-set < result-set ;
  
 -M: postgresql-db make-db* ( seq db -- db )
 -    >r first4 r>
 -        swap >>db
 -        swap >>pass
 -        swap >>user
 -        swap >>host ;
 -
  M: postgresql-db db-open ( db -- db )
      dup {
          [ host>> ]
          [ port>> ]
          [ pgopts>> ]
          [ pgtty>> ]
 -        [ db>> ]
 -        [ user>> ]
 -        [ pass>> ]
 +        [ database>> ]
 +        [ username>> ]
 +        [ password>> ]
      } cleave connect-postgres >>handle ;
  
  M: postgresql-db dispose ( db -- )
@@@ -98,7 -102,7 +98,7 @@@ M: postgresql-result-set dispose ( resu
  
  M: postgresql-statement prepare-statement ( statement -- )
      dup
 -    >r db get handle>> f r>
 +    [ db get handle>> f ] dip
      [ sql>> ] [ in-params>> ] bi
      length f PQprepare postgresql-error
      >>handle drop ;
@@@ -117,8 -121,7 +117,8 @@@ M: postgresql-db bind% ( spec -- 
      bind-name% 1, ;
  
  M: postgresql-db bind# ( spec object -- )
 -    >r bind-name% f swap type>> r> <literal-bind> 1, ;
 +    [ bind-name% f swap type>> ] dip
 +    <literal-bind> 1, ;
  
  : create-table-sql ( class -- statement )
      [
@@@ -140,7 -143,7 +140,7 @@@
  
  : create-function-sql ( class -- statement )
      [
 -        >r remove-id r>
 +        [ remove-id ] dip
          "create function add_" 0% dup 0%
          "(" 0%
          over [ "," 0% ]

diff --combined basis/db/sqlite/sqlite.factor
index dfe4fdf47523d968b8a66bd2845efb0b13b3d8c1,dfd9fab08c49d1cc3f389b92f8cc1fb60e4b21ec..dfe4fdf47523d968b8a66bd2845efb0b13b3d8c1
mode 100755,100644..100644
--- 1/basis/db/sqlite/sqlite.factor
--- 2/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@@@ -11,9 -11,8 +11,9 @@@ IN: db.sqlit
  
  TUPLE: sqlite-db < db path ;
  
 -M: sqlite-db make-db* ( path db -- db )
 -    swap >>path ;
 +: <sqlite-db> ( path -- sqlite-db )
 +    sqlite-db new-db
 +        swap >>path ;
  
  M: sqlite-db db-open ( db -- db )
      dup path>> sqlite-open >>handle ;
@@@ -79,8 -78,7 +79,8 @@@ M: generator-bind sqlite-bind-conversio
      tuck
      [ generator-singleton>> eval-generator tuck ] [ slot-name>> ] bi
      rot set-slot-named
 -    >r [ key>> ] [ type>> ] bi r> swap <sqlite-low-level-binding> ;
 +    [ [ key>> ] [ type>> ] bi ] dip
 +    swap <sqlite-low-level-binding> ;
  
  M: sqlite-statement bind-tuple ( tuple statement -- )
      [
@@@ -102,7 -100,7 +102,7 @@@ M: sqlite-result-set row-column ( resul
  
  M: sqlite-result-set row-column-typed ( result-set n -- obj )
      dup pick out-params>> nth type>>
 -    >r >r handle>> r> r> sqlite-column-typed ;
 +    [ handle>> ] 2dip sqlite-column-typed ;
  
  M: sqlite-result-set advance-row ( result-set -- )
      dup handle>> sqlite-next >>has-more? drop ;
@@@ -162,10 -160,10 +162,10 @@@ M: sqlite-db <insert-user-assigned-stat
      <insert-db-assigned-statement> ;
  
  M: sqlite-db bind# ( spec obj -- )
 -    >r
 -    [ column-name>> ":" swap next-sql-counter 3append dup 0% ]
 -    [ type>> ] bi
 -    r> <literal-bind> 1, ;
 +    [
 +        [ column-name>> ":" swap next-sql-counter 3append dup 0% ]
 +        [ type>> ] bi
 +    ] dip <literal-bind> 1, ;
  
  M: sqlite-db bind% ( spec -- )
      dup 1, column-name>> ":" prepend 0% ;

diff --combined basis/db/tuples/tuples-tests.factor
index f5569a97cd3eda19a93b8fda6c4e4f91caa58a02,6114c7ebe1dc6ecefafe8a52cc13b3e169033db3..f5569a97cd3eda19a93b8fda6c4e4f91caa58a02
mode 100755,100644..100644
--- 1/basis/db/tuples/tuples-tests.factor
--- 2/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@@@ -7,34 -7,16 +7,34 @@@ db.postgresql accessors random math.bit
  math.ranges strings urls fry db.tuples.private ;
  IN: db.tuples.tests
  
 +: sqlite-db ( -- sqlite-db )
 +    "tuples-test.db" temp-file <sqlite-db> ;
 +
  : test-sqlite ( quot -- )
 -    [ ] swap '[
 -        "tuples-test.db" temp-file sqlite-db _ with-db
 -    ] unit-test ;
 +    '[
 +        [ ] [
 +            "tuples-test.db" temp-file <sqlite-db> _ with-db
 +        ] unit-test
 +    ] call ; inline
 +
 +: postgresql-db ( -- postgresql-db )
 +    <postgresql-db>
 +        "localhost" >>host
 +        "postgres" >>username
 +        "thepasswordistrust" >>password
 +        "factor-test" >>database ;
  
  : test-postgresql ( quot -- )
 -    [ ] swap '[
 -        { "localhost" "postgres" "foob" "factor-test" }
 -        postgresql-db _ with-db
 -    ] unit-test ;
 +    '[
 +        [ ] [ postgresql-db _ with-db ] unit-test
 +    ] call ; inline
 +
 +! These words leak resources, but are useful for interactivel testing 
 +: sqlite-test-db ( -- )
 +    sqlite-db db-open db set ;
 +
 +: postgresql-test-db ( -- )
 +    postgresql-db db-open db set ;
  
  TUPLE: person the-id the-name the-number the-real
  ts date time blob factor-blob url ;
@@@ -374,7 -356,9 +374,7 @@@ TUPLE: exam id name score 
      [ f ]
      [ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test
  
 -    ! FIXME
 -    ! [ f ]
 -    ! [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] unit-test
 +    [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] [ class>> "EXAM" = ] must-fail-with
  
      [
          {
@@@ -657,3 -641,10 +657,3 @@@ compound-foo "COMPOUND_FOO
  
  [ test-compound-primary-key ] test-sqlite
  [ test-compound-primary-key ] test-postgresql
 -
 -: sqlite-test-db ( -- )
 -    "tuples-test.db" temp-file sqlite-db make-db db-open db set ;
 -
 -: postgresql-test-db ( -- )
 -    { "localhost" "postgres" "foob" "factor-test" } postgresql-db
 -    make-db db-open db set ;

diff --combined basis/furnace/auth/providers/db/db-tests.factor
index 3bcd82a15dbb7b127abb3f414c5131bede3732a5,fac5c23e4a013a541d711c2786e507fec3b1acdc..3bcd82a15dbb7b127abb3f414c5131bede3732a5
mode 100755,100644..100644
--- 1/basis/furnace/auth/providers/db/db-tests.factor
--- 2/basis/furnace/auth/providers/db/db-tests.factor
+++ b/basis/furnace/auth/providers/db/db-tests.factor
@@@ -11,7 -11,7 +11,7 @@@ io.files accessors kernel 
  \r
  [ "auth-test.db" temp-file delete-file ] ignore-errors\r
  \r
 -"auth-test.db" temp-file sqlite-db [\r
 +"auth-test.db" temp-file <sqlite-db> [\r
  \r
      user ensure-table\r
  \r

diff --combined basis/furnace/db/db.factor
index ed18e42a4fe8c767aa26d34ffd8eff65dc91a432,b4a438601500d774f139925fb761746b2c92e8c8..ed18e42a4fe8c767aa26d34ffd8eff65dc91a432
mode 100755,100644..100644
--- 1/basis/furnace/db/db.factor
--- 2/basis/furnace/db/db.factor
+++ b/basis/furnace/db/db.factor
@@@ -6,7 -6,7 +6,7 @@@ IN: furnace.d
  \r
  TUPLE: db-persistence < filter-responder pool ;\r
  \r
 -: <db-persistence> ( responder params db -- responder' )\r
 +: <db-persistence> ( responder db -- responder' )\r
      <db-pool> db-persistence boa ;\r
  \r
  M: db-persistence call-responder*\r

diff --combined basis/furnace/sessions/sessions-tests.factor
index 6bb3c1cd6927bdfa73c949184a9bf7355d9e9294,ff089a92b22265719bc15d9e377c5578f4a1dc82..6bb3c1cd6927bdfa73c949184a9bf7355d9e9294
mode 100755,100644..100644
--- 1/basis/furnace/sessions/sessions-tests.factor
--- 2/basis/furnace/sessions/sessions-tests.factor
+++ b/basis/furnace/sessions/sessions-tests.factor
@@@ -48,9 -48,9 +48,9 @@@ M: foo call-responder
      <action>\r
          [ [ ] "text/plain" <content> exit-with ] >>display ;\r
  \r
 -[ "auth-test.db" temp-file sqlite-db delete-file ] ignore-errors\r
 +[ "auth-test.db" temp-file delete-file ] ignore-errors\r
  \r
 -"auth-test.db" temp-file sqlite-db [\r
 +"auth-test.db" temp-file <sqlite-db> [\r
  \r
      <request> init-request\r
      session ensure-table\r

diff --combined basis/http/http-tests.factor
index eb8ba34f9e44d268ddcb0fcf1ab0764dc3876a94,49ef03543ece56cf77111822b4bd5c498e301c13..608ba0c88fd1205bf06280376f7086e2eb11cb1b
mode 100755,100644..100644
--- 1/basis/http/http-tests.factor
--- 2/basis/http/http-tests.factor
+++ b/basis/http/http-tests.factor
@@@ -179,10 -179,10 +179,10 @@@ http.server.dispatchers db.tuples 
  
  : add-quit-action
      <action>
-         [ stop-server "Goodbye" "text/html" <content> ] >>display
+         [ stop-this-server "Goodbye" "text/html" <content> ] >>display
      "quit" add-responder ;
  
 -: test-db "test.db" temp-file sqlite-db ;
 +: test-db "test.db" temp-file <sqlite-db> ;
  
  [ test-db drop delete-file ] ignore-errors