This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert t/op/goto_xs.t to test.pl, strict and warnings.
authorNicholas Clark <nick@ccl4.org>
Sat, 12 Mar 2011 17:06:48 +0000 (17:06 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 12 Mar 2011 17:06:48 +0000 (17:06 +0000)
t/op/goto_xs.t

index 3d4afee..79f7192 100644 (file)
@@ -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')
 }