62 lines
1.8 KiB
Factor
62 lines
1.8 KiB
Factor
USING: math tools.test classes.algebra words kernel sequences assocs
|
|
accessors eval definitions compiler.units generic strings classes ;
|
|
IN: classes.predicate.tests
|
|
|
|
PREDICATE: negative < integer 0 < ;
|
|
PREDICATE: positive < integer 0 > ;
|
|
|
|
[ t ] [ negative integer class< ] unit-test
|
|
[ t ] [ positive integer class< ] unit-test
|
|
[ f ] [ integer negative class< ] unit-test
|
|
[ f ] [ integer positive class< ] unit-test
|
|
[ f ] [ negative negative class< ] unit-test
|
|
[ f ] [ positive negative class< ] unit-test
|
|
|
|
GENERIC: abs ( n -- n )
|
|
M: integer abs ;
|
|
M: negative abs -1 * ;
|
|
M: positive abs ;
|
|
|
|
[ 10 ] [ -10 abs ] unit-test
|
|
[ 10 ] [ 10 abs ] unit-test
|
|
[ 0 ] [ 0 abs ] unit-test
|
|
|
|
! Bug report from Bruno Deferrari
|
|
TUPLE: tuple-a slot ;
|
|
TUPLE: tuple-b < tuple-a ;
|
|
|
|
PREDICATE: tuple-c < tuple-b slot>> ;
|
|
|
|
GENERIC: ptest ( tuple -- x )
|
|
M: tuple-a ptest drop tuple-a ;
|
|
M: tuple-c ptest drop tuple-c ;
|
|
|
|
[ tuple-a ] [ tuple-b new ptest ] unit-test
|
|
[ tuple-c ] [ tuple-b new t >>slot ptest ] unit-test
|
|
|
|
PREDICATE: tuple-d < tuple-a slot>> ;
|
|
|
|
GENERIC: ptest' ( tuple -- x )
|
|
M: tuple-a ptest' drop tuple-a ;
|
|
M: tuple-d ptest' drop tuple-d ;
|
|
|
|
[ tuple-a ] [ tuple-b new ptest' ] unit-test
|
|
[ tuple-d ] [ tuple-b new t >>slot ptest' ] unit-test
|
|
|
|
PREDICATE: bad-inheritance-predicate < string ;
|
|
[
|
|
"IN: classes.predicate.tests PREDICATE: bad-inheritance-predicate < bad-inheritance-predicate ;" eval( -- )
|
|
] [ error>> bad-inheritance? ] must-fail-with
|
|
|
|
PREDICATE: bad-inheritance-predicate2 < string ;
|
|
PREDICATE: bad-inheritance-predicate3 < bad-inheritance-predicate2 ;
|
|
[
|
|
"IN: classes.predicate.tests PREDICATE: bad-inheritance-predicate2 < bad-inheritance-predicate3 ;" eval( -- )
|
|
] [ error>> bad-inheritance? ] must-fail-with
|
|
|
|
! This must not fail
|
|
PREDICATE: tup < string ;
|
|
UNION: u tup ;
|
|
|
|
[ ] [ "IN: classes.predicate.tests PREDICATE: u < tup ;" eval( -- ) ] unit-test
|