diff --git a/basis/io/crlf/crlf-tests.factor b/basis/io/crlf/crlf-tests.factor new file mode 100644 index 0000000000..2412945ab3 --- /dev/null +++ b/basis/io/crlf/crlf-tests.factor @@ -0,0 +1,8 @@ +IN: io.crlf.tests +USING: io.crlf tools.test io.streams.string io ; + +[ "Hello, world." ] [ "Hello, world." [ read-crlf ] with-string-reader ] unit-test +[ "Hello, world." ] [ "Hello, world.\r\n" [ read-crlf ] with-string-reader ] unit-test +[ "Hello, world.\r" [ read-crlf ] with-string-reader ] must-fail +[ f ] [ "" [ read-crlf ] with-string-reader ] unit-test +[ "" ] [ "\r\n" [ read-crlf ] with-string-reader ] unit-test diff --git a/basis/io/crlf/crlf.factor b/basis/io/crlf/crlf.factor index 53dddce199..29f10300de 100644 --- a/basis/io/crlf/crlf.factor +++ b/basis/io/crlf/crlf.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: io kernel ; +USING: io kernel sequences ; IN: io.crlf : crlf ( -- ) @@ -8,4 +8,4 @@ IN: io.crlf : read-crlf ( -- seq ) "\r" read-until - [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ; + [ CHAR: \r assert= read1 CHAR: \n assert= ] [ f like ] if* ; diff --git a/extra/benchmark/benchmark.factor b/extra/benchmark/benchmark.factor index 489dc5e73f..ca48e6208c 100755 --- a/extra/benchmark/benchmark.factor +++ b/extra/benchmark/benchmark.factor @@ -1,21 +1,35 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel vocabs vocabs.loader tools.time tools.vocabs arrays assocs io.styles io help.markup prettyprint sequences -continuations debugger math ; +continuations debugger math namespaces ; IN: benchmark -: run-benchmark ( vocab -- result ) + + +: run-benchmark ( vocab -- ) [ "=== " write vocab-name print flush ] [ - [ [ require ] [ [ run ] benchmark ] bi ] curry - [ error. f ] recover + [ [ require ] [ [ run ] benchmark ] [ ] tri timings ] + [ swap errors ] + recover get set-at ] bi ; -: run-benchmarks ( -- assoc ) - "benchmark" all-child-vocabs-seq - [ dup run-benchmark ] { } map>assoc ; +: run-benchmarks ( -- timings errors ) + [ + V{ } clone timings set + V{ } clone errors set + "benchmark" all-child-vocabs-seq + [ run-benchmark ] each + timings get + errors get + ] with-scope ; -: benchmarks. ( assoc -- ) +: timings. ( assocs -- ) standard-table-style [ [ [ "Benchmark" write ] with-cell @@ -24,13 +38,21 @@ IN: benchmark [ [ [ [ 1array $vocab-link ] with-cell ] - [ [ 1000000 /f pprint-cell ] [ [ "failed" write ] with-cell ] if* ] bi* + [ 1000000 /f pprint-cell ] + bi* ] with-row ] assoc-each ] tabular-output nl ; +: benchmark-errors. ( errors -- ) + [ + [ "=== " write vocab-name print ] + [ error. ] + bi* + ] assoc-each ; + : benchmarks ( -- ) - run-benchmarks benchmarks. ; + run-benchmarks [ timings. ] [ benchmark-errors. ] bi* ; MAIN: benchmarks