[ nip ] [ buffer>> buffer-capacity <= ] 2bi
[ drop ] [ stream-flush ] if ; inline
-M: output-port stream-element-type stream>> stream-element-type ; inline
+M: output-port stream-element-type
+ stream>> stream-element-type ; inline
M: output-port stream-write1
dup check-disposed
HOOK: (wait-to-write) io-backend ( port -- )
+: port-flush ( port -- )
+ dup buffer>> buffer-empty?
+ [ drop ] [ dup (wait-to-write) port-flush ] if ;
+
+M: output-port stream-flush ( port -- )
+ [ check-disposed ] [ port-flush ] bi ;
+
HOOK: tell-handle os ( handle -- n )
+
HOOK: seek-handle os ( n seek-type handle -- )
-M: buffered-port stream-tell ( stream -- n )
+M: input-port stream-tell ( stream -- n )
[ check-disposed ]
- [ handle>> tell-handle ]
- [ [ buffer>> size>> - 0 max ] [ buffer>> pos>> ] bi + ] tri ;
+ [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi - ] bi ;
+
+M: output-port stream-tell ( stream -- n )
+ [ check-disposed ]
+ [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
M: input-port stream-seek ( n seek-type stream -- )
[ check-disposed ]
M: object shutdown drop ;
-: port-flush ( port -- )
- dup buffer>> buffer-empty?
- [ drop ] [ dup (wait-to-write) port-flush ] if ;
-
-M: output-port stream-flush ( port -- )
- [ check-disposed ] [ port-flush ] bi ;
-
M: output-port dispose*
[
{
"seek-test1" unique-file binary
[
[
- B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
+ B{ 1 2 3 4 5 } write
+ tell-output 5 assert=
+ 0 seek-absolute seek-output
+ tell-output 0 assert=
B{ 3 } write
+ tell-output 1 assert=
] with-file-writer
] [
file-contents
"seek-test2" unique-file binary
[
[
- B{ 1 2 3 4 5 } write -1 seek-relative seek-output
+ B{ 1 2 3 4 5 } write
+ tell-output 5 assert=
+ -1 seek-relative seek-output
+ tell-output 4 assert=
B{ 3 } write
+ tell-output 5 assert=
] with-file-writer
] [
file-contents
"seek-test3" unique-file binary
[
[
- B{ 1 2 3 4 5 } write 1 seek-relative seek-output
+ B{ 1 2 3 4 5 } write
+ tell-output 5 assert=
+ 1 seek-relative seek-output
+ tell-output 6 assert=
B{ 3 } write
+ tell-output 7 assert=
] with-file-writer
] [
file-contents
set-file-contents
] [
[
- -3 seek-end seek-input 1 read
+ tell-input 0 assert=
+ -3 seek-end seek-input
+ tell-input 2 assert=
+ 1 read
+ tell-input 3 assert=
] with-file-reader
] 2bi
] unit-test
set-file-contents
] [
[
+ tell-input 0 assert=
3 seek-absolute seek-input
+ tell-input 3 assert=
-2 seek-relative seek-input
+ tell-input 1 assert=
1 read
+ tell-input 2 assert=
] with-file-reader
] 2bi
] unit-test