steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

assert that vconvert's inputs are of the right type

db4
Joe Groff 2009-10-06 17:42:36 -05:00
parent f0c161f725
commit 4456b1f3f9
2 changed files with 26 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/math/vectors/conversion/conversion-tests.factor
View File

@ -35,6 +35,18 @@ MACRO:: test-vconvert ( from-type to-type -- )
drop outputs firstn
] ;
[ uint-4{ 5 1 2 6 } int-4 float-4 vconvert ]
[ bad-vconvert-input? ] must-fail-with
[ int-4{ 1 2 3 4 } uint-4{ 5 1 2 6 } int-4 short-8 vconvert ]
[ bad-vconvert-input? ] must-fail-with
[ uint-4{ 1 2 3 4 } int-4{ 5 1 2 6 } int-4 short-8 vconvert ]
[ bad-vconvert-input? ] must-fail-with
[ uint-4{ 5 1 2 6 } int-4 longlong-2 vconvert ]
[ bad-vconvert-input? ] must-fail-with
[ float-4{ -5.0 1.0 2.0 6.0 } ]
[ int-4{ -5 1 2 6 } int-4 float-4 test-vconvert ] unit-test

18
basis/math/vectors/conversion/conversion.factor
View File

@ -1,11 +1,12 @@
! (c)Joe Groff bsd license
USING: accessors alien.c-types arrays assocs combinators
USING: accessors alien.c-types arrays assocs classes combinators
combinators.short-circuit cords fry kernel locals math
math.vectors sequences ;
FROM: alien.c-types => char uchar short ushort int uint longlong ulonglong float double ;
IN: math.vectors.conversion
ERROR: bad-vconvert from-type to-type ;
ERROR: bad-vconvert-input value expected-type ;
<PRIVATE
@ -30,6 +31,9 @@ ERROR: bad-vconvert from-type to-type ;
: unsigned-type? ( c-type -- ? )
{ uchar ushort uint ulonglong } memq? ;
: check-vconvert-type ( value expected-type -- value )
2dup instance? [ drop ] [ bad-vconvert-input ] if ; inline
:: [vconvert] ( from-element to-element from-size to-size from-type to-type -- quot )
{
{
@ -48,7 +52,8 @@ ERROR: bad-vconvert from-type to-type ;
[ to-element float-type? ]
[ [ to-type (v>float) ] ]
}
} cond ;
} cond
[ from-type check-vconvert-type ] prepose ;
:: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot )
from-size to-size /i log2 :> steps
@ -59,7 +64,8 @@ ERROR: bad-vconvert from-type to-type ;
[ from-element unsigned-type? to-element unsigned-type? not and ]
} 0|| [ from-type to-type bad-vconvert ] when
to-type unsigned-type? [ to-type (vpack-unsigned) ] [ to-type (vpack-signed) ] ? ;
to-element unsigned-type? [ to-type (vpack-unsigned) ] [ to-type (vpack-signed) ] ?
[ [ from-type check-vconvert-type ] bi@ ] prepose ;
:: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot )
to-size from-size /i log2 :> steps
@ -70,7 +76,10 @@ ERROR: bad-vconvert from-type to-type ;
[ from-element unsigned-type? not to-element unsigned-type? and ]
} 0|| [ from-type to-type bad-vconvert ] when
[ [ to-type (vunpack-head) ] [ to-type (vunpack-tail) ] bi ] ;
[
from-type check-vconvert-type
[ to-type (vunpack-head) ] [ to-type (vunpack-tail) ] bi
] ;
PRIVATE>
@ -87,3 +96,4 @@ MACRO:: vconvert ( from-type to-type -- )
{ [ from-size to-size = ] [ [vconvert] ] }
{ [ from-size to-size > ] [ [vpack] ] }
} cond ;