Fix set-timeout with dan's new encoding stuff
parent
30171f41df
commit
5904d3fffa
|
@ -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
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 [
|
||||||
|
|
Loading…
Reference in New Issue