}
}
-use Test;
-BEGIN { plan tests => 84 }
+use Test::More tests => 84;
use strict;
use warnings;
use XS::Typemap;
-ok(1);
+pass();
# Some inheritance trees to check ISA relationships
BEGIN {
print "# T_SV\n";
my $sv = "Testing T_SV";
-ok( T_SV($sv), $sv);
+is( T_SV($sv), $sv);
# T_SVREF - reference to Scalar
print "# T_SVREF\n";
$sv .= "REF";
my $svref = \$sv;
-ok( T_SVREF($svref), $svref );
+is( T_SVREF($svref), $svref );
# Now test that a non reference is rejected
# the typemaps croak
print "# T_AVREF\n";
my @array;
-ok( T_AVREF(\@array), \@array);
+is( T_AVREF(\@array), \@array);
# Now test that a non array ref is rejected
eval { T_AVREF( \$sv ) };
print "# T_HVREF\n";
my %hash;
-ok( T_HVREF(\%hash), \%hash);
+is( T_HVREF(\%hash), \%hash);
# Now test that a non hash ref is rejected
eval { T_HVREF( \@array ) };
# T_CVREF - reference to perl subroutine
print "# T_CVREF\n";
my $sub = sub { 1 };
-ok( T_CVREF($sub), $sub );
+is( T_CVREF($sub), $sub );
# Now test that a non code ref is rejected
eval { T_CVREF( \@array ) };
ok( T_SYSRET_pass );
# ... now failure
-ok( T_SYSRET_fail, undef);
+is( T_SYSRET_fail, undef);
# T_UV - unsigned integer
print "# T_UV\n";
-ok( T_UV(5), 5 ); # pass
-ok( T_UV(-4) != -4); # fail
+is( T_UV(5), 5 ); # pass
+isnt( T_UV(-4), -4); # fail
# T_IV - signed integer
print "# T_IV\n";
-ok( T_IV(5), 5);
-ok( T_IV(-4), -4);
-ok( T_IV(4.1), int(4.1));
-ok( T_IV("52"), "52");
-ok( T_IV(4.5) != 4.5); # failure
+is( T_IV(5), 5);
+is( T_IV(-4), -4);
+is( T_IV(4.1), int(4.1));
+is( T_IV("52"), "52");
+isnt( T_IV(4.5), 4.5); # failure
# Skip T_INT
print "# T_U_SHORT\n";
-ok( T_U_SHORT(32000), 32000);
+is( T_U_SHORT(32000), 32000);
if ($Config{shortsize} == 2) {
- ok( T_U_SHORT(65536) != 65536); # probably dont want to test edge cases
+ isnt( 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)
}
print "# T_U_LONG\n";
-ok( T_U_LONG(65536), 65536);
-ok( T_U_LONG(-1) != -1);
+is( T_U_LONG(65536), 65536);
+isnt( T_U_LONG(-1), -1);
# T_CHAR
print "# T_CHAR\n";
-ok( T_CHAR("a"), "a");
-ok( T_CHAR("-"), "-");
-ok( T_CHAR(chr(128)),chr(128));
-ok( T_CHAR(chr(256)) ne chr(256));
+is( T_CHAR("a"), "a");
+is( T_CHAR("-"), "-");
+is( T_CHAR(chr(128)),chr(128));
+isnt( T_CHAR(chr(256)), chr(256));
# T_U_CHAR
print "# T_U_CHAR\n";
-ok( T_U_CHAR(127), 127);
-ok( T_U_CHAR(128), 128);
-ok( T_U_CHAR(-1) != -1);
-ok( T_U_CHAR(300) != 300);
+is( T_U_CHAR(127), 127);
+is( T_U_CHAR(128), 128);
+isnt( T_U_CHAR(-1), -1);
+isnt( T_U_CHAR(300), 300);
# T_FLOAT
print "# T_FLOAT\n";
# limited precision
-ok( sprintf("%6.3f",T_FLOAT(52.345)), sprintf("%6.3f",52.345));
+is( sprintf("%6.3f",T_FLOAT(52.345)), sprintf("%6.3f",52.345));
# T_NV
print "# T_NV\n";
-ok( T_NV(52.345), 52.345);
+is( T_NV(52.345), 52.345);
# T_DOUBLE
print "# T_DOUBLE\n";
-ok( sprintf("%6.3f",T_DOUBLE(52.345)), sprintf("%6.3f",52.345));
+is( sprintf("%6.3f",T_DOUBLE(52.345)), sprintf("%6.3f",52.345));
# T_PV
print "# T_PV\n";
-ok( T_PV("a string"), "a string");
-ok( T_PV(52), 52);
+is( T_PV("a string"), "a string");
+is( T_PV(52), 52);
# T_PTR
print "# T_PTR\n";
my $t = 5;
my $ptr = T_PTR_OUT($t);
-ok( T_PTR_IN( $ptr ), $t );
+is( T_PTR_IN( $ptr ), $t );
# T_PTRREF
print "# T_PTRREF\n";
$t = -52;
$ptr = T_PTRREF_OUT( $t );
-ok( ref($ptr), "SCALAR");
-ok( T_PTRREF_IN( $ptr ), $t );
+is( ref($ptr), "SCALAR");
+is( T_PTRREF_IN( $ptr ), $t );
# test that a non-scalar ref is rejected
eval { T_PTRREF_IN( $t ); };
$t = 256;
$ptr = T_PTROBJ_OUT( $t );
-ok( ref($ptr), "intObjPtr");
-ok( $ptr->T_PTROBJ_IN, $t );
+is( ref($ptr), "intObjPtr");
+is( $ptr->T_PTROBJ_IN, $t );
# check that normal scalar refs fail
eval {intObjPtr::T_PTROBJ_IN( \$t );};
# check that inheritance works
bless $ptr, "intObjPtr::SubClass";
-ok( ref($ptr), "intObjPtr::SubClass");
-ok( $ptr->T_PTROBJ_IN, $t );
+is( ref($ptr), "intObjPtr::SubClass");
+is( $ptr->T_PTROBJ_IN, $t );
# Skip T_REF_IV_REF
$t = -365;
$ptr = T_REF_IV_PTR_OUT( $t );
-ok( ref($ptr), "intRefIvPtr");
-ok( $ptr->T_REF_IV_PTR_IN(), $t);
+is( ref($ptr), "intRefIvPtr");
+is( $ptr->T_REF_IV_PTR_IN(), $t);
# inheritance should not work
bless $ptr, "intRefIvPtr::SubClass";
$t = 22;
my $p = T_OPAQUEPTR_IN( $t );
-ok( T_OPAQUEPTR_OUT($p), $t);
+is( 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));
+is(scalar(@result),scalar(@test));
for (0..$#test) {
- ok($result[$_], $test[$_]);
+ is($result[$_], $test[$_]);
}
# T_OPAQUE
$t = 48;
$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
+is(T_OPAQUEPTR_OUT_short( $p ), $t); # Test using T_OPAQUEPTR
+is(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));
+is(scalar(@uopq), scalar(@opq));
for (0..$#opq) {
- ok( $uopq[$_], $opq[$_]);
+ is( $uopq[$_], $opq[$_]);
}
# Skip T_PACKED
print "# T_ARRAY\n";
my @inarr = (1,2,3,4,5,6,7,8,9,10);
my @outarr = T_ARRAY( 5, @inarr );
-ok(scalar(@outarr), scalar(@inarr));
+is(scalar(@outarr), scalar(@inarr));
for (0..$#inarr) {
- ok($outarr[$_], $inarr[$_]);
+ is($outarr[$_], $inarr[$_]);
}
my @lines = ("NormalSTDIO\n", "PerlIO\n");
# print to it using FILE* through XS
- ok( T_STDIO_print($fh, $lines[0]), length($lines[0]));
+ is( T_STDIO_print($fh, $lines[0]), length($lines[0]));
# print to it using normal perl
ok(print $fh "$lines[1]");
open($fh, "< $testfile");
ok($fh);
my $line = <$fh>;
- ok($line,$lines[0]);
+ is($line,$lines[0]);
$line = <$fh>;
- ok($line,$lines[1]);
+ is($line,$lines[1]);
ok(close($fh));
ok(unlink($testfile));