diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index d5c69ac62e..2584b13d1a 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -22,9 +22,11 @@ - vector-each/map examples - string construction examples - string construction ackward +- read# + tests: +- finish split - java factor: equal numbers have non-equal hashcodes! - sbuf= - vector-hashcode @@ -52,7 +54,6 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable - errors: don't show .factor-rc - handle division by zero - decide if overflow is a fatal error -- f >n: crashes - parsing should be parsing - describe-word - contains ==> contains? diff --git a/library/errors.factor b/library/errors.factor index 835877f88a..feb664160d 100644 --- a/library/errors.factor +++ b/library/errors.factor @@ -42,21 +42,23 @@ USE: vectors : save-error ( error -- ) #! Save the stacks and parser state for post-mortem #! inspection after an error. - "pos" get - "line" get - "line-number" get - "parse-name" get - global [ - "error-parse-name" set - "error-line-number" set - "error-line" set - "error-pos" set - "error" set - datastack >pop> "error-datastack" set - callstack >pop> >pop> "error-callstack" set - namestack "error-namestack" set - catchstack "error-catchstack" set - ] bind ; + namespace [ + "pos" get + "line" get + "line-number" get + "parse-name" get + global [ + "error-parse-name" set + "error-line-number" set + "error-line" set + "error-pos" set + "error" set + datastack >pop> "error-datastack" set + callstack >pop> >pop> "error-callstack" set + namestack "error-namestack" set + catchstack "error-catchstack" set + ] bind + ] when* ; : catch ( try catch -- ) #! Call the try quotation. If an error occurs restore the diff --git a/library/hashtables.factor b/library/hashtables.factor index e23ac1aa97..7defd1194f 100644 --- a/library/hashtables.factor +++ b/library/hashtables.factor @@ -45,7 +45,7 @@ USE: vectors #! array index is determined using a hash function, and the #! buckets are associative lists which are searched #! linearly. The number of buckets must be a power of two. - dup dup >r set-vector-length r> ; + empty-vector ; : (hashcode) ( key table -- index ) #! Compute the index of the bucket for a key. diff --git a/library/httpd/http-common.factor b/library/httpd/http-common.factor index 986844263d..dea811c3dd 100644 --- a/library/httpd/http-common.factor +++ b/library/httpd/http-common.factor @@ -33,7 +33,6 @@ USE: lists USE: logging USE: namespaces USE: parser -USE: regexp USE: stack USE: stdio USE: streams @@ -55,16 +54,15 @@ USE: url-encoding dup log-error <% dup "text/html" response % error-body % %> print ; -: read-header-iter ( alist -- alist ) - read dup "" = [ - drop - ] [ - "(.+?): (.+)" groups [ uncons car cons swons ] when* - read-header-iter - ] ifte ; +: header-line ( alist line -- alist ) + ": " split1 dup [ transp acons ] [ 2drop ] ifte ; + +: (read-header) ( alist -- alist ) + read dup + f-or-"" [ drop ] [ header-line (read-header) ] ifte ; : read-header ( -- alist ) - [ ] read-header-iter ; + [ ] (read-header) ; : content-length ( alist -- length ) "Content-Length" swap assoc dec> ; diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor index c0cf4f3156..f2b2c821e9 100644 --- a/library/httpd/responder.factor +++ b/library/httpd/responder.factor @@ -67,9 +67,6 @@ USE: httpd : no-such-responder ( name -- ) "404 no such responder: " swap cat2 httpd-error ; -: bad-responder-query ( argument -- ) - "404 missing parameter" httpd-error ; - : trim-/ ( url -- url ) #! Trim a leading /, if there is one. dup "/" str-head? dup [ nip ] [ drop ] ifte ; @@ -78,14 +75,9 @@ USE: httpd "Calling responder " swap cat2 log ; : serve-responder ( argument method -- ) - swap - trim-/ - dup "/" split1 dup [ - nip unswons dup get-responder dup [ - swap log-responder call-responder - ] [ - drop nip nip no-such-responder - ] ifte + over log-responder + swap trim-/ "/" split1 over get-responder dup [ + rot drop call-responder ] [ - 3drop bad-responder-query + 2drop no-such-responder drop ] ifte ; diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor index 745fb96e91..2e5fe9ef12 100644 --- a/library/platform/native/boot.factor +++ b/library/platform/native/boot.factor @@ -80,6 +80,8 @@ primitives, "/library/words.factor" "/library/httpd/html.factor" "/library/httpd/url-encoding.factor" + "/library/httpd/http-common.factor" + "/library/httpd/responder.factor" "/library/math/arc-trig-hyp.factor" "/library/math/arithmetic.factor" "/library/math/list-math.factor" @@ -93,7 +95,6 @@ primitives, "/library/platform/native/errors.factor" "/library/platform/native/io-internals.factor" "/library/platform/native/stream.factor" - "/library/platform/native/kernel.factor" "/library/platform/native/namespaces.factor" "/library/platform/native/strings.factor" "/library/platform/native/parse-numbers.factor" @@ -105,6 +106,7 @@ primitives, "/library/platform/native/stack.factor" "/library/platform/native/words.factor" "/library/platform/native/vectors.factor" + "/library/platform/native/kernel.factor" "/library/platform/native/vocabularies.factor" "/library/platform/native/unparser.factor" "/library/platform/native/cross-compiler.factor" diff --git a/library/strings.factor b/library/strings.factor index c54a37cd9f..61b5adbe89 100644 --- a/library/strings.factor +++ b/library/strings.factor @@ -127,18 +127,14 @@ USE: stack swap [ str// ] dip split cons ] ifte ; -: split1 ( string split -- pair ) +: split1 ( string split -- before after ) #! The car of the pair is the string up to the first #! occurrence of split; the cdr is the remainder of #! the string. - dupd index-of dup -1 = [ - drop dup str-length 0 = [ - drop f - ] [ - unit - ] ifte + 2dup index-of dup -1 = [ + 2drop f ] [ - str// cons + swapd str/ rot str-length str/ nip ] ifte ; : max-str-length ( list -- len ) diff --git a/library/test/garbage-collection.factor b/library/test/crashes.factor similarity index 89% rename from library/test/garbage-collection.factor rename to library/test/crashes.factor index b449fded0c..75dc1e0a83 100644 --- a/library/test/garbage-collection.factor +++ b/library/test/crashes.factor @@ -9,7 +9,5 @@ USE: test ! This should run without issue (and tests nothing useful) ! in Java Factor -! This was bloody stupid of me "20 \"foo\" set" eval "garbage-collection" eval - diff --git a/library/test/httpd/httpd.factor b/library/test/httpd/httpd.factor index 57eff613c0..0126256606 100644 --- a/library/test/httpd/httpd.factor +++ b/library/test/httpd/httpd.factor @@ -1,24 +1,46 @@ IN: scratchpad USE: httpd USE: httpd-responder +USE: logging +USE: namespaces USE: stdio USE: test USE: url-encoding -"HTTPD tests" print +[ "HTTP/1.0 404\nContent-Type: text/html\n" ] +[ "404" "text/html" response ] unit-test -[ "hello world" ] [ "hello+world" ] [ url-decode ] test-word -[ "hello world" ] [ "hello%20world" ] [ url-decode ] test-word -[ " ! " ] [ "%20%21%20" ] [ url-decode ] test-word -[ "hello world" ] [ "hello world%" ] [ url-decode ] test-word -[ "hello world" ] [ "hello world%x" ] [ url-decode ] test-word -[ "hello%20world" ] [ "hello world" ] [ url-encode ] test-word -[ "%20%21%20" ] [ " ! " ] [ url-encode ] test-word +[ 5430 ] +[ f "Content-Length: 5430" header-line content-length ] unit-test + + +[ "hello world" ] [ "hello+world" url-decode ] unit-test +[ "hello world" ] [ "hello%20world" url-decode ] unit-test +[ " ! " ] [ "%20%21%20" url-decode ] unit-test +[ "hello world" ] [ "hello world%" url-decode ] unit-test +[ "hello world" ] [ "hello world%x" url-decode ] unit-test +[ "hello%20world" ] [ "hello world" url-encode ] unit-test +[ "%20%21%20" ] [ " ! " url-encode ] unit-test ! These make sure the words work, and don't leave ! extra crap on the stakc [ ] [ "404 not found" ] [ httpd-error ] test-word +[ "arg" ] [ + [ + "arg" "default-argument" set + "" responder-argument + ] with-scope +] unit-test + +[ "inspect/global" ] [ "/inspect/global" trim-/ ] unit-test + +[ ] [ + [ + "unit/test" log-responder + ] with-logging +] unit-test + [ ] [ "/" "get" ] [ serve-responder ] test-word [ ] [ "" "get" ] [ serve-responder ] test-word [ ] [ "test" "get" ] [ serve-responder ] test-word diff --git a/library/test/test.factor b/library/test/test.factor index 7eb454da35..8024a218f5 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -51,7 +51,7 @@ USE: vocabularies "Running Factor test suite..." print "vocabularies" get [ f "scratchpad" set ] bind [ - "garbage-collection" + "crashes" "lists/cons" "lists/lists" "lists/assoc"