From 4456b1f3f9ddaedce3cc9e1df3b7da9de3a28c33 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 6 Oct 2009 17:42:36 -0500
Subject: [PATCH] assert that vconvert's inputs are of the right type

---
 .../vectors/conversion/conversion-tests.factor | 12 ++++++++++++
 .../math/vectors/conversion/conversion.factor  | 18 ++++++++++++++----
 2 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/basis/math/vectors/conversion/conversion-tests.factor b/basis/math/vectors/conversion/conversion-tests.factor
index bd947e84b1..361f6c4027 100644
--- a/basis/math/vectors/conversion/conversion-tests.factor
+++ b/basis/math/vectors/conversion/conversion-tests.factor
@@ -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
 
diff --git a/basis/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor
index 14d5c9b712..7f09e50498 100644
--- a/basis/math/vectors/conversion/conversion.factor
+++ b/basis/math/vectors/conversion/conversion.factor
@@ -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 ;
+