summaryrefslogtreecommitdiff
path: root/t/op/goto_xs.t
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2011-03-12 17:06:48 +0000
committerNicholas Clark <nick@ccl4.org>2011-03-12 17:06:48 +0000
commit0758e0bfd6d4d39eeabc9f405c9c8dd727335f80 (patch)
tree2f624e2051ce32e69b8f3f58545121290294f4e0 /t/op/goto_xs.t
parent437634214c32c38d6863be2710942f00fb607f6f (diff)
downloadperl-0758e0bfd6d4d39eeabc9f405c9c8dd727335f80.tar.gz
Convert t/op/goto_xs.t to test.pl, strict and warnings.
Diffstat (limited to 't/op/goto_xs.t')
-rw-r--r--t/op/goto_xs.t63
1 files changed, 27 insertions, 36 deletions
diff --git a/t/op/goto_xs.t b/t/op/goto_xs.t
index 3d4afee229..79f7192569 100644
--- a/t/op/goto_xs.t
+++ b/t/op/goto_xs.t
@@ -7,21 +7,20 @@
# guessing that if all of these work correctly, the bad ones will
# break correctly as well.
-BEGIN { $| = 1; }
BEGIN {
chdir 't' if -d 't';
- @INC = '../lib';
- $ENV{PERL5LIB} = "../lib";
-
+ require './test.pl';
# turn warnings into fatal errors
$SIG{__WARN__} = sub { die "WARNING: @_" } ;
- foreach (qw(Fcntl XS::APItest)) {
- eval "require $_"
- or do { print "1..0\n# $_ unavailable, can't test XS goto.\n"; exit 0 }
- }
+ skip_all_if_miniperl("no dynamic loading on miniperl, no Fcntl");
+ require Fcntl;
}
-print "1..11\n";
+use strict;
+use warnings;
+use vars '$VALID';
+
+plan(tests => 11);
# We don't know what symbols are defined in platform X's system headers.
# We don't even want to guess, because some platform out there will
@@ -33,70 +32,61 @@ $VALID = 0;
### First, we check whether Fcntl::S_IMODE returns sane answers.
# Fcntl::S_IMODE(0) should always succeed.
-$value = Fcntl::S_IMODE($VALID);
-print((!defined $value)
- ? "not ok 1\n# Sanity check broke, remaining tests will fail.\n"
- : "ok 1\n");
+my $value = Fcntl::S_IMODE($VALID);
+isnt($value, undef, 'Sanity check broke, remaining tests will fail');
### OK, we're ready to do real tests.
-# test "goto &function_constant"
sub goto_const { goto &Fcntl::S_IMODE; }
-$ret = goto_const($VALID);
-print(($ret == $value) ? "ok 2\n" : "not ok 2\n# ($ret != $value)\n");
+my $ret = goto_const($VALID);
+is($ret, $value, 'goto &function_constant');
-# test "goto &$function_package_and_name"
-$FNAME1 = 'Fcntl::S_IMODE';
+my $FNAME1 = 'Fcntl::S_IMODE';
sub goto_name1 { goto &$FNAME1; }
$ret = goto_name1($VALID);
-print(($ret == $value) ? "ok 3\n" : "not ok 3\n# ($ret != $value)\n");
+is($ret, $value, 'goto &$function_package_and_name');
-# test "goto &$function_package_and_name" again, with dirtier stack
$ret = goto_name1($VALID);
-print(($ret == $value) ? "ok 4\n" : "not ok 4\n# ($ret != $value)\n");
+is($ret, $value, 'goto &$function_package_and_name; again, with dirtier stack');
$ret = goto_name1($VALID);
-print(($ret == $value) ? "ok 5\n" : "not ok 5\n# ($ret != $value)\n");
+is($ret, $value, 'goto &$function_package_and_name; again, with dirtier stack');
-# test "goto &$function_name" from local package
+# test
package Fcntl;
-$FNAME2 = 'S_IMODE';
+my $FNAME2 = 'S_IMODE';
sub goto_name2 { goto &$FNAME2; }
package main;
$ret = Fcntl::goto_name2($VALID);
-print(($ret == $value) ? "ok 6\n" : "not ok 6\n# ($ret != $value)\n");
+is($ret, $value, 'goto &$function_name; from local package');
-# test "goto &$function_ref"
-$FREF = \&Fcntl::S_IMODE;
+my $FREF = \&Fcntl::S_IMODE;
sub goto_ref { goto &$FREF; }
$ret = goto_ref($VALID);
-print(($ret == $value) ? "ok 7\n" : "not ok 7\n# ($ret != $value)\n");
+is($ret, $value, 'goto &$function_ref');
### tests where the args are not on stack but in GvAV(defgv) (ie, @_)
-# test "goto &function_constant" from a sub called without arglist
sub call_goto_const { &goto_const; }
$ret = call_goto_const($VALID);
-print(($ret == $value) ? "ok 8\n" : "not ok 8\n# ($ret != $value)\n");
+is($ret, $value, 'goto &function_constant; from a sub called without arglist');
# test "goto &$function_package_and_name" from a sub called without arglist
sub call_goto_name1 { &goto_name1; }
$ret = call_goto_name1($VALID);
-print(($ret == $value) ? "ok 9\n" : "not ok 9\n# ($ret != $value)\n");
+is($ret, $value,
+ 'goto &$function_package_and_name; from a sub called without arglist');
-# test "goto &$function_ref" from a sub called without arglist
sub call_goto_ref { &goto_ref; }
$ret = call_goto_ref($VALID);
-print(($ret == $value) ? "ok 10\n" : "not ok 10\n# ($ret != $value)\n");
-
+is($ret, $value, 'goto &$function_ref; from a sub called without arglist');
-# [perl #35878] croak in XS after goto segfaulted
use XS::APItest qw(mycroak);
@@ -108,6 +98,7 @@ sub goto_croak { goto &mycroak }
eval { goto_croak("boo$_\n") };
$e .= $@;
}
- print $e eq "boo1\nboo2\nboo3\nboo4\n" ? "ok 11\n" : "not ok 11\n";
+ is($e, "boo1\nboo2\nboo3\nboo4\n",
+ '[perl #35878] croak in XS after goto segfaulted')
}