From 028235b9ffc8972bbf74d41eee1ef970ac01d007 Mon Sep 17 00:00:00 2001
From: Bruno Deferrari <utizoc@gmail.com>
Date: Sun, 10 May 2009 20:06:28 -0300
Subject: [PATCH 1/5] extra.redis: Vocabulary for communicating with the Redis
key-value database
---
extra/redis/authors.txt | 1 +
extra/redis/command-writer/authors.txt | 1 +
.../command-writer-tests.factor | 138 ++++++++++++++++++
.../command-writer/command-writer.factor | 104 +++++++++++++
extra/redis/command-writer/summary.txt | 1 +
extra/redis/redis.factor | 74 ++++++++++
extra/redis/response-parser/authors.txt | 1 +
.../response-parser-tests.factor | 20 +++
.../response-parser/response-parser.factor | 27 ++++
extra/redis/response-parser/summary.txt | 1 +
extra/redis/summary.txt | 1 +
11 files changed, 369 insertions(+)
create mode 100644 extra/redis/authors.txt
create mode 100644 extra/redis/command-writer/authors.txt
create mode 100644 extra/redis/command-writer/command-writer-tests.factor
create mode 100644 extra/redis/command-writer/command-writer.factor
create mode 100644 extra/redis/command-writer/summary.txt
create mode 100644 extra/redis/redis.factor
create mode 100644 extra/redis/response-parser/authors.txt
create mode 100644 extra/redis/response-parser/response-parser-tests.factor
create mode 100644 extra/redis/response-parser/response-parser.factor
create mode 100644 extra/redis/response-parser/summary.txt
create mode 100644 extra/redis/summary.txt
diff --git a/extra/redis/authors.txt b/extra/redis/authors.txt
new file mode 100644
index 0000000000..f4a8cb1dc2
--- /dev/null
+++ b/extra/redis/authors.txt
@@ -0,0 +1 @@
+Bruno Deferrari
diff --git a/extra/redis/command-writer/authors.txt b/extra/redis/command-writer/authors.txt
new file mode 100644
index 0000000000..f4a8cb1dc2
--- /dev/null
+++ b/extra/redis/command-writer/authors.txt
@@ -0,0 +1 @@
+Bruno Deferrari
diff --git a/extra/redis/command-writer/command-writer-tests.factor b/extra/redis/command-writer/command-writer-tests.factor
new file mode 100644
index 0000000000..901c4e41f3
--- /dev/null
+++ b/extra/redis/command-writer/command-writer-tests.factor
@@ -0,0 +1,138 @@
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test redis.command-writer io.streams.string ;
+IN: redis.command-writer.tests
+
+#! Connection
+[ "QUIT\r\n" ] [ [ quit ] with-string-writer ] unit-test
+
+[ "PING\r\n" ] [ [ ping ] with-string-writer ] unit-test
+
+[ "AUTH password\r\n" ] [ [ "password" auth ] with-string-writer ] unit-test
+
+#! String values
+[ "SET key 3\r\nfoo\r\n" ] [ [ "foo" "key" set ] with-string-writer ] unit-test
+
+[ "GET key\r\n" ] [ [ "key" get ] with-string-writer ] unit-test
+
+[ "GETSET key 3\r\nfoo\r\n" ] [
+ [ "foo" "key" getset ] with-string-writer
+] unit-test
+
+[ "MGET key1 key2 key3\r\n" ] [
+ [ { "key1" "key2" "key3" } mget ] with-string-writer
+] unit-test
+
+[ "SETNX key 3\r\nfoo\r\n" ] [
+ [ "foo" "key" setnx ] with-string-writer
+] unit-test
+
+[ "INCR key\r\n" ] [ [ "key" incr ] with-string-writer ] unit-test
+
+[ "INCRBY key 7\r\n" ] [ [ 7 "key" incrby ] with-string-writer ] unit-test
+
+[ "DECR key\r\n" ] [ [ "key" decr ] with-string-writer ] unit-test
+
+[ "DECRBY key 7\r\n" ] [ [ 7 "key" decrby ] with-string-writer ] unit-test
+
+[ "EXISTS key\r\n" ] [ [ "key" exists ] with-string-writer ] unit-test
+
+[ "DEL key\r\n" ] [ [ "key" del ] with-string-writer ] unit-test
+
+[ "TYPE key\r\n" ] [ [ "key" type ] with-string-writer ] unit-test
+
+#! Key space
+[ "KEYS pat*\r\n" ] [ [ "pat*" keys ] with-string-writer ] unit-test
+
+[ "RANDOMKEY\r\n" ] [ [ randomkey ] with-string-writer ] unit-test
+
+[ "RENAME key newkey\r\n" ] [
+ [ "newkey" "key" rename ] with-string-writer
+] unit-test
+
+[ "RENAMENX key newkey\r\n" ] [
+ [ "newkey" "key" renamenx ] with-string-writer
+] unit-test
+
+[ "DBSIZE\r\n" ] [ [ dbsize ] with-string-writer ] unit-test
+
+[ "EXPIRE key 7\r\n" ] [ [ 7 "key" expire ] with-string-writer ] unit-test
+
+#! Lists
+[ "RPUSH key 3\r\nfoo\r\n" ] [ [ "foo" "key" rpush ] with-string-writer ] unit-test
+
+[ "LPUSH key 3\r\nfoo\r\n" ] [ [ "foo" "key" lpush ] with-string-writer ] unit-test
+
+[ "LLEN key\r\n" ] [ [ "key" llen ] with-string-writer ] unit-test
+
+[ "LRANGE key 5 9\r\n" ] [ [ 5 9 "key" lrange ] with-string-writer ] unit-test
+
+[ "LTRIM key 5 9\r\n" ] [ [ 5 9 "key" ltrim ] with-string-writer ] unit-test
+
+[ "LINDEX key 7\r\n" ] [ [ 7 "key" lindex ] with-string-writer ] unit-test
+
+[ "LSET key 0 3\r\nfoo\r\n" ] [ [ "foo" 0 "key" lset ] with-string-writer ] unit-test
+
+[ "LREM key 1 3\r\nfoo\r\n" ] [ [ "foo" 1 "key" lrem ] with-string-writer ] unit-test
+
+[ "LPOP key\r\n" ] [ [ "key" lpop ] with-string-writer ] unit-test
+
+[ "RPOP key\r\n" ] [ [ "key" rpop ] with-string-writer ] unit-test
+
+#! Sets
+[ "SADD key 3\r\nfoo\r\n" ] [ [ "foo" "key" sadd ] with-string-writer ] unit-test
+
+[ "SREM key 3\r\nfoo\r\n" ] [ [ "foo" "key" srem ] with-string-writer ] unit-test
+
+[ "SMOVE srckey dstkey 3\r\nfoo\r\n" ] [
+ [ "foo" "dstkey" "srckey" smove ] with-string-writer
+] unit-test
+
+[ "SCARD key\r\n" ] [ [ "key" scard ] with-string-writer ] unit-test
+
+[ "SISMEMBER key 3\r\nfoo\r\n" ] [
+ [ "foo" "key" sismember ] with-string-writer
+] unit-test
+
+[ "SINTER key1 key2 key3\r\n" ] [
+ [ { "key1" "key2" "key3" } sinter ] with-string-writer
+] unit-test
+
+[ "SINTERSTORE dstkey key1 key2 key3\r\n" ] [
+ [ { "key1" "key2" "key3" } "dstkey" sinterstore ] with-string-writer
+] unit-test
+
+[ "SUNION key1 key2 key3\r\n" ] [
+ [ { "key1" "key2" "key3" } sunion ] with-string-writer
+] unit-test
+
+[ "SUNIONSTORE dstkey key1 key2 key3\r\n" ] [
+ [ { "key1" "key2" "key3" } "dstkey" sunionstore ] with-string-writer
+] unit-test
+
+[ "SMEMBERS key\r\n" ] [ [ "key" smembers ] with-string-writer ] unit-test
+
+#! Multiple db
+[ "SELECT 2\r\n" ] [ [ 2 select ] with-string-writer ] unit-test
+
+[ "MOVE key 2\r\n" ] [ [ 2 "key" move ] with-string-writer ] unit-test
+
+[ "FLUSHDB\r\n" ] [ [ flushdb ] with-string-writer ] unit-test
+
+[ "FLUSHALL\r\n" ] [ [ flushall ] with-string-writer ] unit-test
+
+#! Sorting
+
+#! Persistence control
+[ "SAVE\r\n" ] [ [ save ] with-string-writer ] unit-test
+
+[ "BGSAVE\r\n" ] [ [ bgsave ] with-string-writer ] unit-test
+
+[ "LASTSAVE\r\n" ] [ [ lastsave ] with-string-writer ] unit-test
+
+[ "SHUTDOWN\r\n" ] [ [ shutdown ] with-string-writer ] unit-test
+
+#! Remote server control
+[ "INFO\r\n" ] [ [ info ] with-string-writer ] unit-test
+
+[ "MONITOR\r\n" ] [ [ monitor ] with-string-writer ] unit-test
diff --git a/extra/redis/command-writer/command-writer.factor b/extra/redis/command-writer/command-writer.factor
new file mode 100644
index 0000000000..e5e635f457
--- /dev/null
+++ b/extra/redis/command-writer/command-writer.factor
@@ -0,0 +1,104 @@
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: io io.crlf kernel math.parser sequences strings interpolate locals ;
+IN: redis.command-writer
+
+<PRIVATE
+
+GENERIC: write-value-with-length ( value -- )
+
+M: string write-value-with-length
+ [ length number>string write crlf ]
+ [ write ] bi ;
+
+: space ( -- ) CHAR: space write1 ;
+
+: write-key/value ( value key -- )
+ write space
+ write-value-with-length ;
+
+: write-key/integer ( integer key -- )
+ write space
+ number>string write ;
+
+PRIVATE>
+
+#! Connection
+: quit ( -- ) "QUIT" write crlf ;
+: ping ( -- ) "PING" write crlf ;
+: auth ( password -- ) "AUTH " write write crlf ;
+
+#! String values
+: set ( value key -- ) "SET " write write-key/value crlf ;
+: get ( key -- ) "GET " write write crlf ;
+: getset ( value key -- ) "GETSET " write write-key/value crlf ;
+: mget ( keys -- ) "MGET " write " " join write crlf ;
+: setnx ( value key -- ) "SETNX " write write-key/value crlf ;
+: incr ( key -- ) "INCR " write write crlf ;
+: incrby ( integer key -- ) "INCRBY " write write-key/integer crlf ;
+: decr ( key -- ) "DECR " write write crlf ;
+: decrby ( integer key -- ) "DECRBY " write write-key/integer crlf ;
+: exists ( key -- ) "EXISTS " write write crlf ;
+: del ( key -- ) "DEL " write write crlf ;
+: type ( key -- ) "TYPE " write write crlf ;
+
+#! Key space
+: keys ( pattern -- ) "KEYS " write write crlf ;
+: randomkey ( -- ) "RANDOMKEY" write crlf ;
+: rename ( newkey key -- ) "RENAME " write write space write crlf ;
+: renamenx ( newkey key -- ) "RENAMENX " write write space write crlf ;
+: dbsize ( -- ) "DBSIZE" write crlf ;
+: expire ( integer key -- ) "EXPIRE " write write-key/integer crlf ;
+
+#! Lists
+: rpush ( value key -- ) "RPUSH " write write-key/value crlf ;
+: lpush ( value key -- ) "LPUSH " write write-key/value crlf ;
+: llen ( key -- ) "LLEN " write write crlf ;
+: lrange ( start end key -- )
+ "LRANGE " write write [ space number>string write ] bi@ crlf ;
+: ltrim ( start end key -- )
+ "LTRIM " write write [ space number>string write ] bi@ crlf ;
+: lindex ( integer key -- ) "LINDEX " write write-key/integer crlf ;
+: lset ( value index key -- )
+ "LSET " write write-key/integer space write-value-with-length crlf ;
+: lrem ( value amount key -- )
+ "LREM " write write-key/integer space write-value-with-length crlf ;
+: lpop ( key -- ) "LPOP " write write crlf ;
+: rpop ( key -- ) "RPOP " write write crlf ;
+
+#! Sets
+: sadd ( member key -- )
+ "SADD " write write space write-value-with-length crlf ;
+: srem ( member key -- )
+ "SREM " write write space write-value-with-length crlf ;
+: smove ( member newkey key -- )
+ "SMOVE " write write space write space write-value-with-length crlf ;
+: scard ( key -- ) "SCARD " write write crlf ;
+: sismember ( member key -- )
+ "SISMEMBER " write write space write-value-with-length crlf ;
+: sinter ( keys -- ) "SINTER " write " " join write crlf ;
+: sinterstore ( keys destkey -- )
+ "SINTERSTORE " write write space " " join write crlf ;
+: sunion ( keys -- ) "SUNION " write " " join write crlf ;
+: sunionstore ( keys destkey -- )
+ "SUNIONSTORE " write write " " join space write crlf ;
+: smembers ( key -- ) "SMEMBERS " write write crlf ;
+
+#! Multiple db
+: select ( integer -- ) "SELECT " write number>string write crlf ;
+: move ( integer key -- ) "MOVE " write write-key/integer crlf ;
+: flushdb ( -- ) "FLUSHDB" write crlf ;
+: flushall ( -- ) "FLUSHALL" write crlf ;
+
+#! Sorting
+! sort
+
+#! Persistence control
+: save ( -- ) "SAVE" write crlf ;
+: bgsave ( -- ) "BGSAVE" write crlf ;
+: lastsave ( -- ) "LASTSAVE" write crlf ;
+: shutdown ( -- ) "SHUTDOWN" write crlf ;
+
+#! Remote server control
+: info ( -- ) "INFO" write crlf ;
+: monitor ( -- ) "MONITOR" write crlf ;
diff --git a/extra/redis/command-writer/summary.txt b/extra/redis/command-writer/summary.txt
new file mode 100644
index 0000000000..917b915546
--- /dev/null
+++ b/extra/redis/command-writer/summary.txt
@@ -0,0 +1 @@
+Definitions of messages sent to Redis
diff --git a/extra/redis/redis.factor b/extra/redis/redis.factor
new file mode 100644
index 0000000000..1f6d732407
--- /dev/null
+++ b/extra/redis/redis.factor
@@ -0,0 +1,74 @@
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: io redis.response-parser redis.command-writer ;
+IN: redis
+
+#! Connection
+: redis-quit ( -- ) quit flush ;
+: redis-ping ( -- response ) ping flush read-response ;
+: redis-auth ( password -- response ) auth flush read-response ;
+
+#! String values
+: redis-set ( value key -- response ) set flush read-response ;
+: redis-get ( key -- response ) get flush read-response ;
+: redis-getset ( value key -- response ) getset flush read-response ;
+: redis-mget ( keys -- response ) mget flush read-response ;
+: redis-setnx ( value key -- response ) setnx flush read-response ;
+: redis-incr ( key -- response ) incr flush read-response ;
+: redis-incrby ( integer key -- response ) incrby flush read-response ;
+: redis-decr ( key -- response ) decr flush read-response ;
+: redis-decrby ( integer key -- response ) decrby flush read-response ;
+: redis-exists ( key -- response ) exists flush read-response ;
+: redis-del ( key -- response ) del flush read-response ;
+: redis-type ( key -- response ) type flush read-response ;
+
+#! Key space
+: redis-keys ( pattern -- response ) keys flush read-response ;
+: redis-randomkey ( -- response ) randomkey flush read-response ;
+: redis-rename ( newkey key -- response ) rename flush read-response ;
+: redis-renamenx ( newkey key -- response ) renamenx flush read-response ;
+: redis-dbsize ( -- response ) dbsize flush read-response ;
+: redis-expire ( integer key -- response ) expire flush read-response ;
+
+#! Lists
+: redis-rpush ( value key -- response ) rpush flush read-response ;
+: redis-lpush ( value key -- response ) lpush flush read-response ;
+: redis-llen ( key -- response ) llen flush read-response ;
+: redis-lrange ( start end key -- response ) lrange flush read-response ;
+: redis-ltrim ( start end key -- response ) ltrim flush read-response ;
+: redis-lindex ( integer key -- response ) lindex flush read-response ;
+: redis-lset ( value index key -- response ) lset flush read-response ;
+: redis-lrem ( value amount key -- response ) lrem flush read-response ;
+: redis-lpop ( key -- response ) lpop flush read-response ;
+: redis-rpop ( key -- response ) rpop flush read-response ;
+
+#! Sets
+: redis-sadd ( member key -- response ) sadd flush read-response ;
+: redis-srem ( member key -- response ) srem flush read-response ;
+: redis-smove ( member newkey key -- response ) smove flush read-response ;
+: redis-scard ( key -- response ) scard flush read-response ;
+: redis-sismember ( member key -- response ) sismember flush read-response ;
+: redis-sinter ( keys -- response ) sinter flush read-response ;
+: redis-sinterstore ( keys destkey -- response ) sinterstore flush read-response ;
+: redis-sunion ( keys -- response ) sunion flush read-response ;
+: redis-sunionstore ( keys destkey -- response ) sunionstore flush read-response ;
+: redis-smembers ( key -- response ) smembers flush read-response ;
+
+#! Multiple db
+: redis-select ( integer -- response ) select flush read-response ;
+: redis-move ( integer key -- response ) move flush read-response ;
+: redis-flushdb ( -- response ) flushdb flush read-response ;
+: redis-flushall ( -- response ) flushall flush read-response ;
+
+#! Sorting
+! sort
+
+#! Persistence control
+: redis-save ( -- response ) save flush read-response ;
+: redis-bgsave ( -- response ) bgsave flush read-response ;
+: redis-lastsave ( -- response ) lastsave flush read-response ;
+: redis-shutdown ( -- response ) shutdown flush read-response ;
+
+#! Remote server control
+: redis-info ( -- response ) info flush read-response ;
+: redis-monitor ( -- response ) monitor flush read-response ;
diff --git a/extra/redis/response-parser/authors.txt b/extra/redis/response-parser/authors.txt
new file mode 100644
index 0000000000..f4a8cb1dc2
--- /dev/null
+++ b/extra/redis/response-parser/authors.txt
@@ -0,0 +1 @@
+Bruno Deferrari
diff --git a/extra/redis/response-parser/response-parser-tests.factor b/extra/redis/response-parser/response-parser-tests.factor
new file mode 100644
index 0000000000..bde36114c3
--- /dev/null
+++ b/extra/redis/response-parser/response-parser-tests.factor
@@ -0,0 +1,20 @@
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test redis.response-parser io.streams.string ;
+IN: redis.response-parser.tests
+
+[ 1 ] [ ":1\r\n" [ read-response ] with-string-reader ] unit-test
+
+[ "hello" ] [ "$5\r\nhello\r\n" [ read-response ] with-string-reader ] unit-test
+
+[ f ] [ "$-1\r\n" [ read-response ] with-string-reader ] unit-test
+
+[ { "hello" "world!" } ] [
+ "*2\r\n$5\r\nhello\r\n$6\r\nworld!\r\n" [ read-response ] with-string-reader
+] unit-test
+
+[ { "hello" f "world!" } ] [
+ "*3\r\n$5\r\nhello\r\n$-1\r\n$6\r\nworld!\r\n" [
+ read-response
+ ] with-string-reader
+] unit-test
diff --git a/extra/redis/response-parser/response-parser.factor b/extra/redis/response-parser/response-parser.factor
new file mode 100644
index 0000000000..3d92d553b0
--- /dev/null
+++ b/extra/redis/response-parser/response-parser.factor
@@ -0,0 +1,27 @@
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators io kernel math math.parser sequences ;
+IN: redis.response-parser
+
+<PRIVATE
+
+: read-bulk ( n -- bytes ) dup 0 < [ drop f ] [ read 2 read drop ] if ;
+: (read-multi-bulk) ( -- bytes ) readln rest string>number read-bulk ;
+: read-multi-bulk ( n -- seq/f )
+ dup 0 < [ drop f ] [
+ iota [ drop (read-multi-bulk) ] map
+ ] if ;
+
+: handle-response ( string -- string ) ; ! TODO
+: handle-error ( string -- string ) ; ! TODO
+
+PRIVATE>
+
+: read-response ( -- response )
+ readln unclip {
+ { CHAR: : [ string>number ] }
+ { CHAR: + [ handle-response ] }
+ { CHAR: $ [ string>number read-bulk ] }
+ { CHAR: * [ string>number read-multi-bulk ] }
+ { CHAR: - [ handle-error ] }
+ } case ;
diff --git a/extra/redis/response-parser/summary.txt b/extra/redis/response-parser/summary.txt
new file mode 100644
index 0000000000..b89407c7b4
--- /dev/null
+++ b/extra/redis/response-parser/summary.txt
@@ -0,0 +1 @@
+Parser for responses sent by the Redis server
diff --git a/extra/redis/summary.txt b/extra/redis/summary.txt
new file mode 100644
index 0000000000..0cd6e69e38
--- /dev/null
+++ b/extra/redis/summary.txt
@@ -0,0 +1 @@
+Words for communicating with the Redis key-value database
From c92afaf38508640ca67986419e585c3451b31dff Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 10 May 2009 18:20:19 -0500
Subject: [PATCH 2/5] fix rsa tests
---
extra/crypto/rsa/rsa.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor
index 50ea84fd39..f4ef4687b5 100644
--- a/extra/crypto/rsa/rsa.factor
+++ b/extra/crypto/rsa/rsa.factor
@@ -21,7 +21,7 @@ C: <rsa> rsa
CONSTANT: public-key 65537
: rsa-primes ( numbits -- p q )
- 2/ 2 unique-primes first2 ;
+ 2/ 2 swap unique-primes first2 ;
: modulus-phi ( numbits -- n phi )
#! Loop until phi is not divisible by the public key.
From c32927bfeadf6c18c21d62a7ade87e57e7c61361 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.internal.stack-effects.com>
Date: Sun, 10 May 2009 18:54:56 -0500
Subject: [PATCH 3/5] Fix unit test failures caused by change to 'contents'
word
---
basis/base64/base64-tests.factor | 2 +-
basis/urls/encoding/encoding-tests.factor | 4 ++--
basis/urls/urls.factor | 14 ++++++++------
3 files changed, 11 insertions(+), 9 deletions(-)
diff --git a/basis/base64/base64-tests.factor b/basis/base64/base64-tests.factor
index 9094286575..e962fa7e59 100644
--- a/basis/base64/base64-tests.factor
+++ b/basis/base64/base64-tests.factor
@@ -4,7 +4,7 @@ IN: base64.tests
[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
] unit-test
-[ f ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
+[ "" ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
[ "a" ] [ "a" ascii encode >base64 base64> ascii decode ] unit-test
[ "ab" ] [ "ab" ascii encode >base64 base64> ascii decode ] unit-test
[ "abc" ] [ "abc" ascii encode >base64 base64> ascii decode ] unit-test
diff --git a/basis/urls/encoding/encoding-tests.factor b/basis/urls/encoding/encoding-tests.factor
index 78e31a764d..f3e0497588 100644
--- a/basis/urls/encoding/encoding-tests.factor
+++ b/basis/urls/encoding/encoding-tests.factor
@@ -2,8 +2,8 @@ IN: urls.encoding.tests
USING: urls.encoding tools.test arrays kernel assocs present accessors ;
[ "~hello world" ] [ "%7ehello world" url-decode ] unit-test
-[ f ] [ "%XX%XX%XX" url-decode ] unit-test
-[ f ] [ "%XX%XX%X" url-decode ] unit-test
+[ "" ] [ "%XX%XX%XX" url-decode ] unit-test
+[ "" ] [ "%XX%XX%X" url-decode ] unit-test
[ "hello world" ] [ "hello%20world" url-decode ] unit-test
[ " ! " ] [ "%20%21%20" url-decode ] unit-test
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 1e886ae3e2..a72fac567a 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -25,12 +25,14 @@ TUPLE: url protocol username password host port path query anchor ;
] if ;
: parse-host ( string -- host port )
- ":" split1 [ url-decode ] [
- dup [
- string>number
- dup [ "Invalid port" throw ] unless
- ] when
- ] bi* ;
+ [
+ ":" split1 [ url-decode ] [
+ dup [
+ string>number
+ dup [ "Invalid port" throw ] unless
+ ] when
+ ] bi*
+ ] [ f f ] if* ;
GENERIC: >url ( obj -- url )
From 9986f6e23e756cc9a3198be6a4f31ca79d847c73 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.internal.stack-effects.com>
Date: Sun, 10 May 2009 19:01:38 -0500
Subject: [PATCH 4/5] Fix bool type on PowerPC
---
basis/alien/c-types/c-types.factor | 9 +++++----
basis/cpu/ppc/ppc.factor | 8 +++++++-
2 files changed, 12 insertions(+), 5 deletions(-)
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 6067c90f2d..df5a5bbba8 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -259,8 +259,9 @@ M: long-long-type box-return ( type -- )
[ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
(( value -- c-ptr )) define-inline ;
-: c-bool> ( int -- ? )
- 0 = not ; inline
+: >c-bool ( ? -- int ) 1 0 ? ; inline
+
+: c-bool> ( int -- ? ) 0 = not ; inline
: define-primitive-type ( type name -- )
[ typedef ]
@@ -409,8 +410,8 @@ CONSTANT: primitive-types
"uchar" define-primitive-type
<c-type>
- [ alien-unsigned-1 zero? not ] >>getter
- [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
+ [ alien-unsigned-1 c-bool> ] >>getter
+ [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
1 >>size
1 >>align
"box_boolean" >>boxer
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 442dd8e7ea..314ea830f8 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -713,4 +713,10 @@ USE: vocabs.loader
} cond
"complex-double" c-type t >>return-in-registers? drop
-"bool" c-type 4 >>size 4 >>align drop
\ No newline at end of file
+
+"bool" c-type
+4 >>size
+4 >>align
+[ alien-unsigned-1 c-bool> ] >>getter
+[ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
+drop
\ No newline at end of file
From 05e0171dea6296ddc58027d1f49d488e798a00d5 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 10 May 2009 19:10:20 -0500
Subject: [PATCH 5/5] cpu.ppc: really fix bool type
---
basis/cpu/ppc/ppc.factor | 22 +++++++++++++---------
1 file changed, 13 insertions(+), 9 deletions(-)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 314ea830f8..dc7108b3a1 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -2,11 +2,11 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sequences kernel combinators make math
math.order math.ranges system namespaces locals layouts words
-alien alien.c-types literals cpu.architecture cpu.ppc.assembler
-cpu.ppc.assembler.backend literals compiler.cfg.registers
+alien alien.accessors alien.c-types literals cpu.architecture
+cpu.ppc.assembler cpu.ppc.assembler.backend literals compiler.cfg.registers
compiler.cfg.instructions compiler.constants compiler.codegen
compiler.codegen.fixup compiler.cfg.intrinsics
-compiler.cfg.stack-frame ;
+compiler.cfg.stack-frame compiler.units ;
IN: cpu.ppc
! PowerPC register assignments:
@@ -714,9 +714,13 @@ USE: vocabs.loader
"complex-double" c-type t >>return-in-registers? drop
-"bool" c-type
-4 >>size
-4 >>align
-[ alien-unsigned-1 c-bool> ] >>getter
-[ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
-drop
\ No newline at end of file
+[
+ <c-type>
+ [ alien-unsigned-4 c-bool> ] >>getter
+ [ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter
+ 4 >>size
+ 4 >>align
+ "box_boolean" >>boxer
+ "to_boolean" >>unboxer
+ "bool" define-primitive-type
+] with-compilation-unit