Fix test failures
parent
36f324370a
commit
c753fc98d0
|
@ -51,6 +51,7 @@ M: object set-nth-unsafe set-nth ;
|
|||
M: f length drop 0 ;
|
||||
M: f nth nip ;
|
||||
M: f nth-unsafe nip ;
|
||||
M: f like drop dup empty? [ drop f ] when ;
|
||||
|
||||
! Integers support the sequence protocol
|
||||
M: integer length ;
|
||||
|
|
|
@ -21,12 +21,17 @@ math namespaces sequences words ;
|
|||
[ math-class-compare 0 > ] 2keep ? ;
|
||||
|
||||
: (math-upgrade) ( max class -- quot )
|
||||
dupd = [ drop [ ] ] [ "coercer" word-prop ] if ;
|
||||
dupd = [
|
||||
drop [ ]
|
||||
] [
|
||||
"coercer" word-prop [ [ ] ] unless*
|
||||
] if ;
|
||||
|
||||
: math-upgrade ( left right -- quot )
|
||||
[ math-class-max ] 2keep
|
||||
>r over r> (math-upgrade)
|
||||
>r (math-upgrade) dup [ 1 make-dip ] when r> append ;
|
||||
>r (math-upgrade) dup empty? [ 1 make-dip ] unless
|
||||
r> append ;
|
||||
|
||||
TUPLE: no-math-method left right generic ;
|
||||
|
||||
|
|
|
@ -91,9 +91,9 @@ unit-test
|
|||
[ [ 3 2 1 ] ] [ [ 1 2 3 ] reverse ] unit-test
|
||||
|
||||
[ f ] [ 0 f head ] unit-test
|
||||
[ f ] [ 0 [ 1 ] head ] unit-test
|
||||
[ [ ] ] [ 0 [ 1 ] head ] unit-test
|
||||
[ [ 1 2 3 ] ] [ 3 [ 1 2 3 4 ] head ] unit-test
|
||||
[ f ] [ 3 [ 1 2 3 ] tail ] unit-test
|
||||
[ [ ] ] [ 3 [ 1 2 3 ] tail ] unit-test
|
||||
[ [ 3 ] ] [ 2 [ 1 2 3 ] tail ] unit-test
|
||||
|
||||
[ t ] [ [ 1 2 3 ] [ 1 2 3 ] sequence= ] unit-test
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
IN: temporary
|
||||
USING: generic kernel lists math memory words prettyprint
|
||||
USING: generic kernel math memory words prettyprint
|
||||
sequences test ;
|
||||
|
||||
TUPLE: testing x y z ;
|
||||
|
@ -9,14 +9,9 @@ TUPLE: testing x y z ;
|
|||
[ ] [
|
||||
num-types [
|
||||
type>class [
|
||||
dup \ cons = [
|
||||
! too many conses!
|
||||
drop
|
||||
] [
|
||||
"predicate" word-prop instances [
|
||||
class drop
|
||||
] each
|
||||
] if
|
||||
"predicate" word-prop instances [
|
||||
class drop
|
||||
] each
|
||||
] when*
|
||||
] each
|
||||
] unit-test
|
||||
|
|
Loading…
Reference in New Issue