diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 606d1a0edf..0d08c592a9 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -5,7 +5,7 @@ quotations classes classes.algebra classes.tuple.private 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 ) @@ -447,3 +447,14 @@ TUPLE: grid-mesh-tuple { length read-only } { step read-only } ; 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 diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index 6d2dec1c0d..09750d9d3f 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -288,14 +288,12 @@ generic-comparison-ops [ literal>> dup tuple-class? [ drop tuple ] unless ] "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?>>