diff --git a/basis/typed/typed-tests.factor b/basis/typed/typed-tests.factor index d8cbb814d8..f7b853cff7 100644 --- a/basis/typed/typed-tests.factor +++ b/basis/typed/typed-tests.factor @@ -1,4 +1,5 @@ -USING: accessors effects eval kernel layouts math quotations tools.test typed words ; +USING: accessors effects eval kernel layouts math namespaces +quotations tools.test typed words ; IN: typed.tests TYPED: f+ ( a: float b: float -- c: float ) @@ -71,3 +72,28 @@ IN: typed.tests T{ unboxable f 12 3 4.0 } unboxy xy>> """ eval( -- xy ) ] unit-test + +TYPED: no-inputs ( -- out: integer ) + 1 ; + +[ 1 ] [ no-inputs ] unit-test + +TUPLE: unboxable3 + { x read-only } ; + +TYPED: no-inputs-unboxable-output ( -- out: unboxable3 ) + T{ unboxable3 } ; + +[ T{ unboxable3 } ] [ no-inputs-unboxable-output ] unit-test + +SYMBOL: buh + +TYPED: no-outputs ( x: integer -- ) + buh set ; + +[ 2 ] [ 2 no-outputs buh get ] unit-test + +TYPED: no-outputs-unboxable-input ( x: unboxable3 -- ) + buh set ; + +[ T{ unboxable3 } ] [ T{ unboxable3 } no-outputs-unboxable-input buh get ] unit-test diff --git a/basis/typed/typed.factor b/basis/typed/typed.factor index 84a8ea3217..ec96902d72 100644 --- a/basis/typed/typed.factor +++ b/basis/typed/typed.factor @@ -79,7 +79,8 @@ DEFER: make-boxer [ drop [ ] ] if ; : make-boxer ( types -- quot ) - [ boxer ] [ swap '[ @ _ dip ] ] map-reduce ; + [ [ ] ] + [ [ boxer ] [ swap '[ @ _ dip ] ] map-reduce ] if-empty ; ! defining typed words