Improved ERROR:
parent
cb121c5b50
commit
72d9c040b4
|
@ -656,3 +656,28 @@ T{ reshape-test f "hi" } "tuple" set
|
|||
TUPLE: boa-coercer-test { x array-capacity } ;
|
||||
|
||||
[ fixnum ] [ 0 >bignum boa-coercer-test boa x>> class ] unit-test
|
||||
|
||||
! Test error classes
|
||||
ERROR: error-class-test a b c ;
|
||||
|
||||
[ "( a b c -- * )" ] [ \ error-class-test stack-effect effect>string ] unit-test
|
||||
[ f ] [ \ error-class-test "inline" word-prop ] unit-test
|
||||
|
||||
[ "IN: classes.tuple.tests ERROR: error-x ; : error-x 3 ;" eval ]
|
||||
[ error>> error>> redefine-error? ] must-fail-with
|
||||
|
||||
DEFER: error-y
|
||||
|
||||
[ ] [ [ \ error-y forget-class ] with-compilation-unit ] unit-test
|
||||
|
||||
[ ] [ "IN: classes.tuple.tests GENERIC: error-y" eval ] unit-test
|
||||
|
||||
[ f ] [ \ error-y tuple-class? ] unit-test
|
||||
|
||||
[ t ] [ \ error-y generic? ] unit-test
|
||||
|
||||
[ ] [ "IN: classes.tuple.tests ERROR: error-y ;" eval ] unit-test
|
||||
|
||||
[ t ] [ \ error-y tuple-class? ] unit-test
|
||||
|
||||
[ f ] [ \ error-y generic? ] unit-test
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: arrays definitions hashtables kernel kernel.private math
|
|||
namespaces sequences sequences.private strings vectors words
|
||||
quotations memory combinators generic classes classes.algebra
|
||||
classes.private slots.deprecated slots.private slots
|
||||
compiler.units math.private accessors assocs ;
|
||||
compiler.units math.private accessors assocs effects ;
|
||||
IN: classes.tuple
|
||||
|
||||
M: tuple class 1 slot 2 slot { word } declare ;
|
||||
|
@ -255,9 +255,13 @@ M: tuple-class define-tuple-class
|
|||
3dup tuple-class-unchanged?
|
||||
[ 3drop ] [ redefine-tuple-class ] if ;
|
||||
|
||||
: thrower-effect ( slots -- effect )
|
||||
[ dup array? [ first ] when ] map f <effect> t >>terminated? ;
|
||||
|
||||
: define-error-class ( class superclass slots -- )
|
||||
[ define-tuple-class ] [ 2drop ] 3bi
|
||||
dup [ boa throw ] curry define ;
|
||||
[ define-tuple-class ]
|
||||
[ [ dup [ boa throw ] curry ] [ drop ] [ thrower-effect ] tri* ] 3bi
|
||||
define-declared ;
|
||||
|
||||
M: tuple-class reset-class
|
||||
[
|
||||
|
|
|
@ -175,6 +175,7 @@ IN: bootstrap.syntax
|
|||
|
||||
"ERROR:" [
|
||||
parse-tuple-definition
|
||||
pick reset-generic
|
||||
pick save-location
|
||||
define-error-class
|
||||
] define-syntax
|
||||
|
|
Loading…
Reference in New Issue