continuations growable namespaces hints alien.accessors
compiler.tree.builder compiler.tree.optimizer sequences.deep
compiler.test definitions generic.single shuffle math.order
-compiler.cfg.debugger ;
+compiler.cfg.debugger classes.struct alien.syntax alien.data ;
IN: compiler.tests.optimizer
GENERIC: xyz ( obj -- obj )
GENERIC: bad-push-test-case ( a -- b )
M: object bad-push-test-case "foo" throw ; inline
[ { 1 } "bar" ] [ { 1 } [ [ [ [ bad-push-test-case ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test
+
+STRUCT: BitmapData { Scan0 void* } ;
+
+[ ALIEN: 123 ] [
+ [
+ { BitmapData }
+ [ BitmapData memory>struct ALIEN: 123 >>Scan0 drop ]
+ [ clone ]
+ with-out-parameters Scan0>>
+ ] compile-call
+] unit-test
literal>> dup tuple-class? [ drop tuple ] unless <class-info>
] "outputs" set-word-prop
-! the output of clone has the same type as the input
+! the output of (clone) has the same type as the input
: cloned-value-info ( value-info -- value-info' )
clone f >>literal f >>literal?
[ [ dup [ cloned-value-info ] when ] map ] change-slots ;
-{ clone (clone) } [
- [ cloned-value-info ] "outputs" set-word-prop
-] each
+\ (clone) [ cloned-value-info ] "outputs" set-word-prop
\ slot [
dup literal?>>
byte-vectors system io.encodings math.order io.backend
continuations classes byte-arrays namespaces splitting grouping
dlists alien alien.c-types assocs io.encodings.binary summary
-accessors destructors combinators fry specialized-arrays ;
+accessors destructors combinators fry specialized-arrays
+locals ;
SPECIALIZED-ARRAY: uchar
IN: io.ports
[ check-disposed ]
[ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
+:: do-seek-relative ( n seek-type stream -- n seek-type stream )
+ ! seek-relative needs special handling here, because of the
+ ! buffer.
+ seek-type seek-relative eq?
+ [ n stream stream-tell + seek-absolute ] [ n seek-type ] if
+ stream ;
+
M: input-port stream-seek ( n seek-type stream -- )
+ do-seek-relative
[ check-disposed ]
[ buffer>> 0 swap buffer-reset ]
[ handle>> seek-handle ] tri ;
M: output-port stream-seek ( n seek-type stream -- )
+ do-seek-relative
[ check-disposed ]
[ stream-flush ]
[ handle>> seek-handle ] tri ;
] with-file-reader
] must-fail
+[ ] [
+ "resource:misc/icons/Factor_48x48.png" binary [
+ 44 read drop
+ tell-input 44 assert=
+ -44 seek-relative seek-input
+ tell-input 0 assert=
+ ] with-file-reader
+] unit-test
+
[
"non-string-error" unique-file ascii [
{ } write