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 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 } ] [ float-4{ -5.0 1.0 2.0 6.0 } ]
[ int-4{ -5 1 2 6 } int-4 float-4 test-vconvert ] unit-test [ 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 ! (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 combinators.short-circuit cords fry kernel locals math
math.vectors sequences ; math.vectors sequences ;
FROM: alien.c-types => char uchar short ushort int uint longlong ulonglong float double ; FROM: alien.c-types => char uchar short ushort int uint longlong ulonglong float double ;
IN: math.vectors.conversion IN: math.vectors.conversion
ERROR: bad-vconvert from-type to-type ; ERROR: bad-vconvert from-type to-type ;
ERROR: bad-vconvert-input value expected-type ;
<PRIVATE <PRIVATE
@ -30,6 +31,9 @@ ERROR: bad-vconvert from-type to-type ;
: unsigned-type? ( c-type -- ? ) : unsigned-type? ( c-type -- ? )
{ uchar ushort uint ulonglong } memq? ; { 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 ) :: [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-element float-type? ]
[ [ to-type (v>float) ] ] [ [ 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 ) :: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot )
from-size to-size /i log2 :> steps 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 ] [ from-element unsigned-type? to-element unsigned-type? not and ]
} 0|| [ from-type to-type bad-vconvert ] when } 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 ) :: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot )
to-size from-size /i log2 :> steps 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 ] [ from-element unsigned-type? not to-element unsigned-type? and ]
} 0|| [ from-type to-type bad-vconvert ] when } 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> PRIVATE>
@ -87,3 +96,4 @@ MACRO:: vconvert ( from-type to-type -- )
{ [ from-size to-size = ] [ [vconvert] ] } { [ from-size to-size = ] [ [vconvert] ] }
{ [ from-size to-size > ] [ [vpack] ] } { [ from-size to-size > ] [ [vpack] ] }
} cond ; } cond ;