More DWIMminess for Class::Struct: calling the array or hash
[p5sagit/p5-mst-13.2.git] / t / lib / xs-typemap.t
index 131c32e..0cf1ab3 100644 (file)
@@ -1,10 +1,15 @@
 BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bXS\/Typemap\b/) {
+        print "1..0 # Skip: XS::Typemap was not built\n";
+        exit 0;
+    }
 }
 
 use Test;
-BEGIN { plan tests => 78 }
+BEGIN { plan tests => 84 }
 
 use strict;
 use warnings;
@@ -122,7 +127,11 @@ ok( ! T_BOOL(undef) );
 print "# T_U_SHORT\n";
 
 ok( T_U_SHORT(32000), 32000);
-ok( T_U_SHORT(65536) != 65536); # probably dont want to test edge cases
+if ($Config{shortsize} == 2) {
+  ok( T_U_SHORT(65536) != 65536); # probably dont want to test edge cases
+} else {
+  ok(1); # e.g. Crays have shortsize 4 (T3X) or 8 (CXX and SVX)
+}
 
 # T_U_LONG aka U32
 
@@ -153,7 +162,7 @@ ok( T_U_CHAR(300) != 300);
 print "# T_FLOAT\n";
 
 # limited precision
-ok( sprintf("%6.3f",T_FLOAT(52.345)), 52.345);
+ok( sprintf("%6.3f",T_FLOAT(52.345)), sprintf("%6.3f",52.345));
 
 # T_NV
 print "# T_NV\n";
@@ -163,7 +172,7 @@ ok( T_NV(52.345), 52.345);
 # T_DOUBLE
 print "# T_DOUBLE\n";
 
-ok( T_DOUBLE(52.345), 52.345);
+ok( sprintf("%6.3f",T_DOUBLE(52.345)), sprintf("%6.3f",52.345));
 
 # T_PV
 print "# T_PV\n";
@@ -232,20 +241,35 @@ ok( $@ );
 print "# T_OPAQUEPTR\n";
 
 $t = 22;
-$ptr = T_OPAQUEPTR_IN( $t );
-ok( T_OPAQUEPTR_OUT($ptr), $t);
+my $p = T_OPAQUEPTR_IN( $t );
+ok( T_OPAQUEPTR_OUT($p), $t);
+
+# T_OPAQUEPTR with a struct
+print "# T_OPAQUEPTR with a struct\n";
+
+my @test = (5,6,7);
+$p = T_OPAQUEPTR_IN_struct(@test);
+my @result = T_OPAQUEPTR_OUT_struct($p);
+ok(scalar(@result),scalar(@test));
+for (0..$#test) {
+  ok($result[$_], $test[$_]);
+}
 
 # T_OPAQUE
 print "# T_OPAQUE\n";
 
 $t = 48;
-$ptr = T_OPAQUE_IN( $t );
-ok(T_OPAQUEPTR_OUT_short( $ptr ), $t);
+$p = T_OPAQUE_IN( $t );
+ok(T_OPAQUEPTR_OUT_short( $p ), $t); # Test using T_OPAQUEPTR
+ok(T_OPAQUE_OUT( $p ), $t );         # Test using T_OPQAQUE
 
 # T_OPAQUE_array
+print "# A packed  array\n";
+
 my @opq = (2,4,8);
 my $packed = T_OPAQUE_array(@opq);
 my @uopq = unpack("i*",$packed);
+ok(scalar(@uopq), scalar(@opq));
 for (0..$#opq) {
   ok( $uopq[$_], $opq[$_]);
 }