2009-05-01 23:14:26 -04:00
|
|
|
! Copyright (C) 2007, 2009 Daniel Ehrenberg.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2007-10-06 13:37:11 -04:00
|
|
|
USING: inverse tools.test arrays math kernel sequences
|
2009-05-01 23:14:26 -04:00
|
|
|
math.functions math.constants continuations combinators.smart ;
|
2018-01-24 08:30:21 -05:00
|
|
|
IN: inverse.tests
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 2 } [ { 3 2 } [ 3 swap 2array ] undo ] unit-test
|
2008-02-06 14:47:19 -05:00
|
|
|
[ { 3 4 } [ dup 2array ] undo ] must-fail
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
TUPLE: foo bar baz ;
|
|
|
|
|
|
|
|
C: <foo> foo
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 1 2 } [ 1 2 <foo> [ <foo> ] undo ] unit-test
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: 2same ( x -- {x,x} ) dup 2array ;
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ t } [ { 3 3 } [ 2same ] matches? ] unit-test
|
|
|
|
{ f } [ { 3 4 } [ 2same ] matches? ] unit-test
|
2008-02-06 14:47:19 -05:00
|
|
|
[ [ 2same ] matches? ] must-fail
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: something ( array -- num )
|
|
|
|
{
|
2009-08-13 20:21:44 -04:00
|
|
|
{ [ dup 1 + 2array ] [ 3 * ] }
|
2007-09-20 18:09:08 -04:00
|
|
|
{ [ 3array ] [ + + ] }
|
2007-11-22 00:43:30 -05:00
|
|
|
} switch ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 5 } [ { 1 2 2 } something ] unit-test
|
|
|
|
{ 6 } [ { 2 3 } something ] unit-test
|
2008-02-06 14:47:19 -05:00
|
|
|
[ { 1 } something ] must-fail
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-06 14:47:19 -05:00
|
|
|
[ 1 2 [ eq? ] undo ] must-fail
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: f>c ( *fahrenheit -- *celsius )
|
|
|
|
32 - 1.8 / ;
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ { 212.0 32.0 } } [ { 100 0 } [ [ f>c ] map ] undo ] unit-test
|
|
|
|
{ { t t f } } [ { t f 1 } [ [ >boolean ] matches? ] map ] unit-test
|
|
|
|
{ { t f } } [ { { 1 2 3 } 4 } [ [ >array ] matches? ] map ] unit-test
|
|
|
|
{ 9 9 } [ 3 [ 1/2 ^ ] undo 3 [ sqrt ] undo ] unit-test
|
|
|
|
{ 5 } [ 6 5 - [ 6 swap - ] undo ] unit-test
|
|
|
|
{ 6 } [ 6 5 - [ 5 - ] undo ] unit-test
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
TUPLE: cons car cdr ;
|
|
|
|
|
|
|
|
C: <cons> cons
|
|
|
|
|
|
|
|
TUPLE: nil ;
|
|
|
|
|
|
|
|
C: <nil> nil
|
|
|
|
|
|
|
|
: list-sum ( list -- sum )
|
|
|
|
{
|
|
|
|
{ [ <cons> ] [ list-sum + ] }
|
|
|
|
{ [ <nil> ] [ 0 ] }
|
2008-04-07 01:45:46 -04:00
|
|
|
[ "Malformed list" throw ]
|
2007-11-22 00:43:30 -05:00
|
|
|
} switch ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 10 } [ 1 2 3 4 <nil> <cons> <cons> <cons> <cons> list-sum ] unit-test
|
|
|
|
{ } [ <nil> [ <nil> ] undo ] unit-test
|
|
|
|
{ 1 2 } [ 1 2 <cons> [ <cons> ] undo ] unit-test
|
|
|
|
{ t } [ 1 2 <cons> [ <cons> ] matches? ] unit-test
|
|
|
|
{ f } [ 1 2 <cons> [ <foo> ] matches? ] unit-test
|
|
|
|
{ "Malformed list" } [ [ f list-sum ] [ ] recover ] unit-test
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-13 16:06:27 -04:00
|
|
|
: empty-cons ( -- cons ) cons new ;
|
2008-08-29 05:23:39 -04:00
|
|
|
: cons* ( cdr car -- cons ) cons boa ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ } [ T{ cons f f f } [ empty-cons ] undo ] unit-test
|
|
|
|
{ 1 2 } [ 1 2 <cons> [ cons* ] undo ] unit-test
|
2007-11-22 00:52:15 -05:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ t } [ pi [ pi ] matches? ] unit-test
|
|
|
|
{ 0.0 } [ 0.0 pi + [ pi + ] undo ] unit-test
|
|
|
|
{ } [ 3 [ __ ] undo ] unit-test
|
2009-01-04 15:59:55 -05:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 2.0 } [ 2 3 ^ [ 3 ^ ] undo ] unit-test
|
|
|
|
{ 3.0 } [ 2 3 ^ [ 2 swap ^ ] undo ] unit-test
|
2009-02-04 18:31:25 -05:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ { 1 } } [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
|
|
|
|
{ { 3 } } [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
|
2009-01-04 15:59:55 -05:00
|
|
|
[ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
|
|
|
|
[ { 1 2 3 } [ { 2 3 } prepend ] undo ] must-fail
|
2009-01-13 10:39:34 -05:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ [ sq ] } [ [ sqrt ] [undo] ] unit-test
|
|
|
|
{ [ sqrt ] } [ [ sq ] [undo] ] unit-test
|
|
|
|
{ [ not ] } [ [ not ] [undo] ] unit-test
|
|
|
|
{ { 3 2 1 } } [ { 1 2 3 } [ reverse ] undo ] unit-test
|
2009-04-22 20:35:51 -04:00
|
|
|
|
|
|
|
TUPLE: funny-tuple ;
|
|
|
|
: <funny-tuple> ( -- funny-tuple ) \ funny-tuple boa ;
|
|
|
|
: funny-tuple ( -- ) "OOPS" throw ;
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ } [ [ <funny-tuple> ] [undo] drop ] unit-test
|
2009-05-01 23:14:26 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 0 } [ { 1 2 } [ [ 1 + 2 ] { } output>sequence ] undo ] unit-test
|
|
|
|
{ { 0 1 } } [ 1 2 [ [ [ 1 + ] bi@ ] input<sequence ] undo ] unit-test
|