Merge branch 'master' of git://factorcode.org/git/factor
commit
c12d6fe543
|
@ -391,6 +391,17 @@ DEFER: loop-bbb
|
|||
|
||||
[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test
|
||||
|
||||
! Interval inference issue
|
||||
[ f ] [
|
||||
10 70
|
||||
[
|
||||
dup 70 >=
|
||||
[ dup 700 <= [ swap 1024 rem rem ] [ 2drop 70 ] if ]
|
||||
[ 2drop 70 ] if
|
||||
70 >=
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
! Modular arithmetic bug
|
||||
: modular-arithmetic-bug ( a -- b ) >integer 256 mod ;
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: math.intervals kernel sequences words math math.order
|
||||
arrays prettyprint tools.test random vocabs combinators
|
||||
accessors math.constants ;
|
||||
accessors math.constants fry ;
|
||||
IN: math.intervals.tests
|
||||
|
||||
[ empty-interval ] [ 2 2 (a,b) ] unit-test
|
||||
|
@ -246,7 +246,7 @@ IN: math.intervals.tests
|
|||
} case
|
||||
] if ;
|
||||
|
||||
: random-unary-op ( -- pair )
|
||||
: unary-ops ( -- alist )
|
||||
{
|
||||
{ bitnot interval-bitnot }
|
||||
{ abs interval-abs }
|
||||
|
@ -257,11 +257,10 @@ IN: math.intervals.tests
|
|||
}
|
||||
"math.ratios.private" vocab [
|
||||
{ recip interval-recip } suffix
|
||||
] when
|
||||
random ;
|
||||
] when ;
|
||||
|
||||
: unary-test ( -- ? )
|
||||
random-interval random-unary-op ! 2dup . .
|
||||
: unary-test ( op -- ? )
|
||||
[ random-interval ] dip
|
||||
0 pick interval-contains? over first \ recip eq? and [
|
||||
2drop t
|
||||
] [
|
||||
|
@ -269,9 +268,11 @@ IN: math.intervals.tests
|
|||
second execute( a -- b ) interval-contains?
|
||||
] if ;
|
||||
|
||||
[ t ] [ 80000 iota [ drop unary-test ] all? ] unit-test
|
||||
unary-ops [
|
||||
[ [ t ] ] dip '[ 8000 iota [ drop _ unary-test ] all? ] unit-test
|
||||
] each
|
||||
|
||||
: random-binary-op ( -- pair )
|
||||
: binary-ops ( -- alist )
|
||||
{
|
||||
{ + interval+ }
|
||||
{ - interval- }
|
||||
|
@ -282,17 +283,15 @@ IN: math.intervals.tests
|
|||
{ bitand interval-bitand }
|
||||
{ bitor interval-bitor }
|
||||
{ bitxor interval-bitxor }
|
||||
! { shift interval-shift }
|
||||
{ min interval-min }
|
||||
{ max interval-max }
|
||||
}
|
||||
"math.ratios.private" vocab [
|
||||
{ / interval/ } suffix
|
||||
] when
|
||||
random ;
|
||||
] when ;
|
||||
|
||||
: binary-test ( -- ? )
|
||||
random-interval random-interval random-binary-op ! 3dup . . .
|
||||
: binary-test ( op -- ? )
|
||||
[ random-interval random-interval ] dip
|
||||
0 pick interval-contains? over first { / /i mod rem } member? and [
|
||||
3drop t
|
||||
] [
|
||||
|
@ -300,22 +299,26 @@ IN: math.intervals.tests
|
|||
second execute( a b -- c ) interval-contains?
|
||||
] if ;
|
||||
|
||||
[ t ] [ 80000 iota [ drop binary-test ] all? ] unit-test
|
||||
binary-ops [
|
||||
[ [ t ] ] dip '[ 8000 iota [ drop _ binary-test ] all? ] unit-test
|
||||
] each
|
||||
|
||||
: random-comparison ( -- pair )
|
||||
: comparison-ops ( -- alist )
|
||||
{
|
||||
{ < interval< }
|
||||
{ <= interval<= }
|
||||
{ > interval> }
|
||||
{ >= interval>= }
|
||||
} random ;
|
||||
} ;
|
||||
|
||||
: comparison-test ( -- ? )
|
||||
random-interval random-interval random-comparison
|
||||
: comparison-test ( op -- ? )
|
||||
[ random-interval random-interval ] dip
|
||||
[ [ [ random-element ] bi@ ] dip first execute( a b -- ? ) ] 3keep
|
||||
second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
|
||||
|
||||
[ t ] [ 40000 iota [ drop comparison-test ] all? ] unit-test
|
||||
comparison-ops [
|
||||
[ [ t ] ] dip '[ 8000 iota [ drop _ comparison-test ] all? ] unit-test
|
||||
] each
|
||||
|
||||
[ t ] [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
|
||||
|
||||
|
@ -335,18 +338,19 @@ IN: math.intervals.tests
|
|||
: random-interval-or-empty ( -- obj )
|
||||
10 random 0 = [ empty-interval ] [ random-interval ] if ;
|
||||
|
||||
: random-commutative-op ( -- op )
|
||||
: commutative-ops ( -- seq )
|
||||
{
|
||||
interval+ interval*
|
||||
interval-bitor interval-bitand interval-bitxor
|
||||
interval-max interval-min
|
||||
} random ;
|
||||
} ;
|
||||
|
||||
[ t ] [
|
||||
80000 iota [
|
||||
drop
|
||||
random-interval-or-empty random-interval-or-empty
|
||||
random-commutative-op
|
||||
[ execute ] [ swapd execute ] 3bi =
|
||||
] all?
|
||||
] unit-test
|
||||
commutative-ops [
|
||||
[ [ t ] ] dip '[
|
||||
8000 iota [
|
||||
drop
|
||||
random-interval-or-empty random-interval-or-empty _
|
||||
[ execute ] [ swapd execute ] 3bi =
|
||||
] all?
|
||||
] unit-test
|
||||
] each
|
||||
|
|
|
@ -340,8 +340,8 @@ SYMBOL: incomparable
|
|||
{
|
||||
{ [ over empty-interval eq? ] [ drop ] }
|
||||
{ [ dup empty-interval eq? ] [ nip ] }
|
||||
{ [ dup full-interval eq? ] [ nip ] }
|
||||
[ (rem-range) 2dup interval-subset? [ drop ] [ nip ] if ]
|
||||
{ [ dup full-interval eq? ] [ 2drop [0,inf] ] }
|
||||
[ nip (rem-range) ]
|
||||
} cond ;
|
||||
|
||||
: interval->fixnum ( i1 -- i2 )
|
||||
|
|
Loading…
Reference in New Issue