diff options
author | Nicholas Clark <nick@ccl4.org> | 2011-03-12 17:06:48 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2011-03-12 17:06:48 +0000 |
commit | 0758e0bfd6d4d39eeabc9f405c9c8dd727335f80 (patch) | |
tree | 2f624e2051ce32e69b8f3f58545121290294f4e0 /t/op/goto_xs.t | |
parent | 437634214c32c38d6863be2710942f00fb607f6f (diff) | |
download | perl-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.t | 63 |
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') } |