[ string-nth ] final-info first interval>> 0 23 2^ [a,b] =
] unit-test
+! Optimization on instance?
+[ f ] [ [ { number } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
+
+UNION: ?fixnum fixnum POSTPONE: f ;
+[ t ] [ [ { ?fixnum } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
+[ t ] [ [ { fixnum } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
+
+! Actually check to make sure that the generated code works properly
+: instance-test-1 ( x -- ? ) { ?fixnum } declare fixnum instance? ;
+: instance-test-2 ( x -- ? ) { number } declare fixnum instance? ;
+: instance-test-3 ( x -- ? ) { POSTPONE: f } declare \ f instance? ;
+
+[ t ] [ 1 instance-test-1 ] unit-test
+[ f ] [ f instance-test-1 ] unit-test
+[ t ] [ 1 instance-test-2 ] unit-test
+[ f ] [ 1.1 instance-test-2 ] unit-test
+[ t ] [ f instance-test-3 ] unit-test
+
+[ t ] [ [ { ?fixnum } declare >fixnum ] { >fixnum } inlined? ] unit-test
+[ f ] [ [ { integer } declare >fixnum ] { >fixnum } inlined? ] unit-test
+
+[ f ] [ [ { word } declare parent-word ] { parent-word } inlined? ] unit-test
+
+! Make sure guarded method inlining installs the right dependencies
+
+[ ] [
+ "IN: compiler.tree.propagation.tests
+ USING: kernel.private accessors ;
+ TUPLE: foo bar ;
+ UNION: ?foo foo POSTPONE: f ;
+ : baz ( ?foo -- bar ) { ?foo } declare bar>> ;" eval( -- )
+] unit-test
+
+[ 3 ] [ "USE: kernel IN: compiler.tree.propagation.tests 3 foo boa baz" eval( -- x ) ] unit-test
+
+[ ] [ "IN: compiler.tree.propagation.tests TUPLE: foo baz bar ;" eval( -- ) ] unit-test
+
+[ 3 ] [ "USE: kernel IN: compiler.tree.propagation.tests 2 3 foo boa baz" eval( -- x ) ] unit-test
++
+ ! Non-zero displacement for <displaced-alien> restricts the output type
+ [ t ] [
+ [ { byte-array } declare <displaced-alien> ] final-classes
+ first byte-array alien class-or class=
+ ] unit-test
+
+ [ V{ alien } ] [
+ [ { alien } declare <displaced-alien> ] final-classes
+ ] unit-test
+
+ [ t ] [
+ [ { POSTPONE: f } declare <displaced-alien> ] final-classes
+ first \ f alien class-or class=
+ ] unit-test
+
+ [ V{ alien } ] [
+ [ { byte-array } declare [ 10 bitand 2 + ] dip <displaced-alien> ] final-classes
+ ] unit-test