steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixing HTTP and IANA tests

db4
Daniel Ehrenberg 2009-02-03 19:44:28 -06:00
parent 246c4bb13c
commit 594f21e5bd
2 changed files with 9 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/http/http.factor
View File

@ -3,17 +3,11 @@
USING: accessors kernel combinators math namespaces make assocs USING: accessors kernel combinators math namespaces make assocs
sequences splitting sorting sets strings vectors hashtables sequences splitting sorting sets strings vectors hashtables
quotations arrays byte-arrays math.parser calendar quotations arrays byte-arrays math.parser calendar
calendar.format present urls calendar.format present urls fry
io io.encodings io.encodings.iana io.encodings.binary io io.encodings io.encodings.iana io.encodings.binary
io.encodings.8-bit io.crlf io.encodings.8-bit io.crlf
unicode.case unicode.categories unicode.case unicode.categories
http.parsers ; http.parsers ;
EXCLUDE: fry => , ;
IN: http IN: http
: (read-header) ( -- alist ) : (read-header) ( -- alist )
@ -217,5 +211,7 @@ TUPLE: post-data data params content-type content-encoding ;
" " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ; " " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
: parse-content-type ( content-type -- type encoding ) : parse-content-type ( content-type -- type encoding )
";" split1 parse-content-type-attributes "charset" swap at ";" split1
name>encoding over "text/" head? latin1 binary ? or ; parse-content-type-attributes "charset" swap at
[ name>encoding ]
[ dup "text/" head? latin1 binary ? ] if* ;

8
basis/io/encodings/iana/iana-tests.factor
View File

@ -1,5 +1,5 @@
USING: io.encodings.iana io.encodings.iana.private USING: io.encodings.iana io.encodings.iana.private
io.encodings.utf8 tools.test assocs ; io.encodings.utf8 tools.test assocs namespaces ;
IN: io.encodings.iana.tests IN: io.encodings.iana.tests
[ utf8 ] [ "UTF-8" name>encoding ] unit-test [ utf8 ] [ "UTF-8" name>encoding ] unit-test
@ -15,9 +15,9 @@ ebcdic-fisea "EBCDIC-FI-SE-A" register-encoding
! Clean up after myself ! Clean up after myself
[ ] [ [ ] [
"EBCDIC-FI-SE-A" n>e-table delete-at "EBCDIC-FI-SE-A" n>e-table get delete-at
"csEBCDICFISEA" n>e-table delete-at "csEBCDICFISEA" n>e-table get delete-at
ebcdic-fisea e>n-table delete-at ebcdic-fisea e>n-table get delete-at
] unit-test ] unit-test
[ "EBCDIC-FI-SE-A" name>encoding ] must-fail [ "EBCDIC-FI-SE-A" name>encoding ] must-fail
[ "csEBCDICFISEA" name>encoding ] must-fail [ "csEBCDICFISEA" name>encoding ] must-fail