2005-03-29 19:48:17 -05:00
|
|
|
IN: temporary
|
2005-07-17 15:22:06 -04:00
|
|
|
USING: io-internals kernel kernel-internals sequences test ;
|
|
|
|
|
|
|
|
: buffer-append ( buffer buffer -- )
|
|
|
|
#! Append first buffer to second buffer.
|
|
|
|
2dup buffer-end over buffer-ptr rot buffer-fill memcpy
|
|
|
|
>r buffer-fill r> n>buffer ;
|
|
|
|
|
|
|
|
: buffer-set ( string buffer -- )
|
|
|
|
2dup buffer-ptr string>memory
|
|
|
|
>r length r> buffer-reset ;
|
|
|
|
|
|
|
|
: string>buffer ( string -- buffer )
|
|
|
|
dup length <buffer> tuck buffer-set ;
|
2005-03-29 19:48:17 -05:00
|
|
|
|
|
|
|
[ "" 65536 ] [
|
|
|
|
65536 <buffer>
|
|
|
|
dup buffer-contents
|
|
|
|
over buffer-capacity
|
|
|
|
rot buffer-free
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ "hello world" "" ] [
|
2005-04-03 19:02:50 -04:00
|
|
|
"hello world" string>buffer
|
2005-03-29 19:48:17 -05:00
|
|
|
dup buffer-contents
|
|
|
|
0 pick buffer-reset
|
|
|
|
over buffer-contents
|
|
|
|
rot buffer-free
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ "hello" ] [
|
2005-04-03 19:02:50 -04:00
|
|
|
"hello world" string>buffer
|
2005-03-29 19:48:17 -05:00
|
|
|
5 over buffer-first-n swap buffer-free
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ 11 ] [
|
2005-04-03 19:02:50 -04:00
|
|
|
"hello world" string>buffer
|
2005-03-29 19:48:17 -05:00
|
|
|
[ buffer-length ] keep buffer-free
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ "hello world" ] [
|
2005-04-03 19:02:50 -04:00
|
|
|
"hello" 1024 <buffer> [ buffer-set ] keep
|
2005-04-03 16:55:56 -04:00
|
|
|
" world" over >buffer
|
2005-03-29 19:48:17 -05:00
|
|
|
dup buffer-contents swap buffer-free
|
|
|
|
] unit-test
|
2005-04-03 16:55:56 -04:00
|
|
|
|
|
|
|
[ CHAR: e ] [
|
2005-04-03 19:02:50 -04:00
|
|
|
"hello" string>buffer
|
2005-04-07 18:54:02 -04:00
|
|
|
1 over buffer-consume [ buffer-pop ] keep buffer-free
|
2005-04-03 16:55:56 -04:00
|
|
|
] unit-test
|
2005-04-09 00:09:49 -04:00
|
|
|
|
|
|
|
[ "Hello world" ] [
|
|
|
|
" world" string>buffer
|
|
|
|
"Hello" string>buffer
|
|
|
|
2dup buffer-append
|
|
|
|
[ buffer-contents ] keep buffer-free swap buffer-free
|
|
|
|
] unit-test
|