summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/t/op/goto_xs.t
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/t/op/goto_xs.t')
-rwxr-xr-xcontrib/perl5/t/op/goto_xs.t98
1 files changed, 0 insertions, 98 deletions
diff --git a/contrib/perl5/t/op/goto_xs.t b/contrib/perl5/t/op/goto_xs.t
deleted file mode 100755
index cf2cafd..0000000
--- a/contrib/perl5/t/op/goto_xs.t
+++ /dev/null
@@ -1,98 +0,0 @@
-#!./perl
-# tests for "goto &sub"-ing into XSUBs
-
-# $RCSfile$$Revision$$Date$
-
-# Note: This only tests things that should *work*. At some point, it may
-# be worth while to write some failure tests for things that should
-# *break* (such as calls with wrong number of args). For now, I'm
-# guessing that if all of these work correctly, the bad ones will
-# break correctly as well.
-
-chdir 't' if -d 't';
-@INC = '../lib';
-$ENV{PERL5LIB} = "../lib";
-
-# turn warnings into fatal errors
-$SIG{__WARN__} = sub { die "WARNING: @_" } ;
-
-BEGIN { $| = 1; }
-eval 'require Fcntl'
- or do { print "1..0\n# Fcntl unavailable, can't test XS goto.\n"; exit 0 };
-
-print "1..10\n";
-
-# 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
-# likely do the unthinkable. However, Fcntl::constant("LOCK_SH",0)
-# should always return a value, even on platforms which don't define the
-# cpp symbol; Fcntl.xs says:
-# /* We support flock() on systems which don't have it, so
-# always supply the constants. */
-# If this ceases to be the case, we're in trouble. =)
-$VALID = 'LOCK_SH';
-
-### First, we check whether Fcntl::constant returns sane answers.
-# Fcntl::constant("LOCK_SH",0) should always succeed.
-
-$value = Fcntl::constant($VALID,0);
-print((!defined $value)
- ? "not ok 1\n# Sanity check broke, remaining tests will fail.\n"
- : "ok 1\n");
-
-### OK, we're ready to do real tests.
-
-# test "goto &function_constant"
-sub goto_const { goto &Fcntl::constant; }
-
-$ret = goto_const($VALID,0);
-print(($ret == $value) ? "ok 2\n" : "not ok 2\n# ($ret != $value)\n");
-
-# test "goto &$function_package_and_name"
-$FNAME1 = 'Fcntl::constant';
-sub goto_name1 { goto &$FNAME1; }
-
-$ret = goto_name1($VALID,0);
-print(($ret == $value) ? "ok 3\n" : "not ok 3\n# ($ret != $value)\n");
-
-# test "goto &$function_package_and_name" again, with dirtier stack
-$ret = goto_name1($VALID,0);
-print(($ret == $value) ? "ok 4\n" : "not ok 4\n# ($ret != $value)\n");
-$ret = goto_name1($VALID,0);
-print(($ret == $value) ? "ok 5\n" : "not ok 5\n# ($ret != $value)\n");
-
-# test "goto &$function_name" from local package
-package Fcntl;
-$FNAME2 = 'constant';
-sub goto_name2 { goto &$FNAME2; }
-package main;
-
-$ret = Fcntl::goto_name2($VALID,0);
-print(($ret == $value) ? "ok 6\n" : "not ok 6\n# ($ret != $value)\n");
-
-# test "goto &$function_ref"
-$FREF = \&Fcntl::constant;
-sub goto_ref { goto &$FREF; }
-
-$ret = goto_ref($VALID,0);
-print(($ret == $value) ? "ok 7\n" : "not ok 7\n# ($ret != $value)\n");
-
-### 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,0);
-print(($ret == $value) ? "ok 8\n" : "not ok 8\n# ($ret != $value)\n");
-
-# test "goto &$function_package_and_name" from a sub called without arglist
-sub call_goto_name1 { &goto_name1; }
-
-$ret = call_goto_name1($VALID,0);
-print(($ret == $value) ? "ok 9\n" : "not ok 9\n# ($ret != $value)\n");
-
-# test "goto &$function_ref" from a sub called without arglist
-sub call_goto_ref { &goto_ref; }
-
-$ret = call_goto_ref($VALID,0);
-print(($ret == $value) ? "ok 10\n" : "not ok 10\n# ($ret != $value)\n");
OpenPOWER on IntegriCloud