Fix set-timeout with dan's new encoding stuff

db4
Slava Pestov 2008-03-19 15:24:49 -05:00
parent 30171f41df
commit 5904d3fffa
4 changed files with 28 additions and 19 deletions

View File

@ -1,6 +1,6 @@
USING: alien arrays definitions generic assocs hashtables io USING: alien arrays definitions generic assocs hashtables io
kernel math namespaces parser prettyprint sequences strings kernel math namespaces parser prettyprint sequences strings
tools.test vectors words quotations classes io.streams.string tools.test vectors words quotations classes
classes.private classes.union classes.mixin classes.predicate classes.private classes.union classes.mixin classes.predicate
vectors definitions source-files compiler.units ; vectors definitions source-files compiler.units ;
IN: classes.tests IN: classes.tests
@ -63,10 +63,6 @@ UNION: c a b ;
UNION: bah fixnum alien ; UNION: bah fixnum alien ;
[ bah ] [ \ bah? "predicating" word-prop ] unit-test [ bah ] [ \ bah? "predicating" word-prop ] unit-test
! Test generic see and parsing
[ "USING: alien math ;\nIN: classes.tests\nUNION: bah fixnum alien ;\n" ]
[ [ \ bah see ] with-string-writer ] unit-test
! Test redefinition of classes ! Test redefinition of classes
UNION: union-1 fixnum float ; UNION: union-1 fixnum float ;
@ -180,6 +176,8 @@ UNION: forget-class-bug-2 forget-class-bug-1 dll ;
[ f ] [ forget-class-bug-2 typemap get values [ memq? ] with contains? ] unit-test [ f ] [ forget-class-bug-2 typemap get values [ memq? ] with contains? ] unit-test
USE: io.streams.string
2 [ 2 [
[ "mixin-forget-test" forget-source ] with-compilation-unit [ "mixin-forget-test" forget-source ] with-compilation-unit
@ -224,3 +222,7 @@ MIXIN: flat-mx-2 INSTANCE: flat-mx-2 flat-mx-1
TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2 TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
[ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test [ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test
! Test generic see and parsing
[ "USING: alien math ;\nIN: classes.tests\nUNION: bah fixnum alien ;\n" ]
[ [ \ bah see ] with-string-writer ] unit-test

View File

@ -14,19 +14,26 @@ GENERIC: encode-char ( char stream encoding -- )
GENERIC: <decoder> ( stream decoding -- newstream ) GENERIC: <decoder> ( stream decoding -- newstream )
GENERIC: <encoder> ( stream encoding -- newstream )
: replacement-char HEX: fffd ; : replacement-char HEX: fffd ;
! Decoding TUPLE: decoder stream code cr ;
<PRIVATE
TUPLE: decode-error ; TUPLE: decode-error ;
: decode-error ( -- * ) \ decode-error construct-empty throw ; : decode-error ( -- * ) \ decode-error construct-empty throw ;
TUPLE: decoder stream code cr ; GENERIC: <encoder> ( stream encoding -- newstream )
TUPLE: encoder stream code ;
TUPLE: encode-error ;
: encode-error ( -- * ) \ encode-error construct-empty throw ;
! Decoding
<PRIVATE
M: tuple-class <decoder> construct-empty <decoder> ; M: tuple-class <decoder> construct-empty <decoder> ;
M: tuple <decoder> f decoder construct-boa ; M: tuple <decoder> f decoder construct-boa ;
@ -101,12 +108,6 @@ M: decoder stream-readln ( stream -- str )
M: decoder dispose decoder-stream dispose ; M: decoder dispose decoder-stream dispose ;
! Encoding ! Encoding
TUPLE: encode-error ;
: encode-error ( -- * ) \ encode-error construct-empty throw ;
TUPLE: encoder stream code ;
M: tuple-class <encoder> construct-empty <encoder> ; M: tuple-class <encoder> construct-empty <encoder> ;
M: tuple <encoder> encoder construct-boa ; M: tuple <encoder> encoder construct-boa ;
@ -132,6 +133,7 @@ INSTANCE: encoder plain-writer
: redecode ( stream encoding -- newstream ) : redecode ( stream encoding -- newstream )
over decoder? [ >r decoder-stream r> ] when <decoder> ; over decoder? [ >r decoder-stream r> ] when <decoder> ;
PRIVATE> PRIVATE>
: <encoder-duplex> ( stream-in stream-out encoding -- duplex ) : <encoder-duplex> ( stream-in stream-out encoding -- duplex )

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov, Doug Coleman ! Copyright (C) 2008 Slava Pestov, Doug Coleman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel calendar alarms io.streams.duplex ; USING: kernel calendar alarms io.streams.duplex io.encodings ;
IN: io.timeouts IN: io.timeouts
! Won't need this with new slot accessors ! Won't need this with new slot accessors
@ -12,6 +12,10 @@ M: duplex-stream set-timeout
duplex-stream-in set-timeout duplex-stream-in set-timeout
duplex-stream-out set-timeout ; duplex-stream-out set-timeout ;
M: decoder set-timeout decoder-stream set-timeout ;
M: encoder set-timeout encoder-stream set-timeout ;
GENERIC: timed-out ( obj -- ) GENERIC: timed-out ( obj -- )
M: object timed-out drop ; M: object timed-out drop ;

View File

@ -1,6 +1,7 @@
IN: tools.deploy.tests IN: tools.deploy.tests
USING: tools.test system io.files kernel tools.deploy.config USING: tools.test system io.files kernel tools.deploy.config
tools.deploy.backend math sequences io.launcher arrays ; tools.deploy.backend math sequences io.launcher arrays
namespaces ;
: shake-and-bake ( vocab -- ) : shake-and-bake ( vocab -- )
"." resource-path [ "." resource-path [