summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-10-29 01:13:54 -0700
committerFather Chrysostomos <sprout@cpan.org>2011-10-29 01:13:54 -0700
commit3a18813b31ea9acdba52560ab9409ec6880b7f71 (patch)
tree6eb5544b70f65cf60c49cf2d39b5a773b6f7cd51
parent6d9e773fa83b824dd302669a87212a81f22f941e (diff)
downloadperl-sprout/overrides.tar.gz
Make all keywords overridablesprout/overrides
-rw-r--r--lib/feature.pm11
-rw-r--r--t/op/override.t35
-rw-r--r--toke.c5
3 files changed, 47 insertions, 4 deletions
diff --git a/lib/feature.pm b/lib/feature.pm
index e20285d595..a17b65684e 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -8,6 +8,7 @@ my %feature = (
state => 'feature_state',
switch => 'feature_switch',
unicode_strings => 'feature_unicode',
+ overrides => 'feature_overrides',
);
# This gets set (for now) in $^H as well as in %^H,
@@ -23,7 +24,7 @@ my %feature_bundle = (
"5.12" => [qw(say state switch unicode_strings)],
"5.13" => [qw(say state switch unicode_strings)],
"5.14" => [qw(say state switch unicode_strings)],
- "5.15" => [qw(say state switch unicode_strings)],
+ "5.15" => [qw(say state switch unicode_strings overrides)],
);
# special case
@@ -126,6 +127,14 @@ C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
This subpragma is available starting with Perl 5.11.3, but was not fully
implemented until 5.13.8.
+=head2 the 'overrides' feature
+
+C<use feature 'overrides'> tells the compiler to allow all Perl keywords to
+be overridden with user-defined subroutines. See
+L<perlsub/Overriding Built-in Functions>.
+
+This subpragma is available from Perl 5.16 onwards.
+
=head1 FEATURE BUNDLES
It's possible to load a whole slew of features in one go, using
diff --git a/t/op/override.t b/t/op/override.t
index 413ba77e84..d0829cc44e 100644
--- a/t/op/override.t
+++ b/t/op/override.t
@@ -6,7 +6,36 @@ BEGIN {
require './test.pl';
}
-plan tests => 26;
+
+# Test that every keyword is overridable under 5.16.
+
+use File::Spec::Functions;
+use subs ();
+
+my $keywords_file = catfile(updir,'regen','keywords.pl');
+open my $kh, $keywords_file
+ or die "$0 cannot open $keywords_file: $!";
+
+my $keyword_count;
+
+while($_ = CORE::readline $kh) {
+ if (m?__END__?..${\0} and /^\+/) {
+ chomp(my $word = $');
+ next if $word =~ /^[A-Z]+\z/;
+ $keyword_count++;
+ my $rand = rand;
+ use feature sprintf(":%vd", $^V); # need to use the latest, to make
+ local *$word = sub { $rand }; # sure we test all keywords properly
+ subs->import($word);
+ local $_; # to avoid strange side effects when tests fail
+ is eval qq{$word()}, $rand, "$word under 'overrides' feature";
+ }
+}
+
+close $kh or die "$0 cannot close $keywords_file: $!";
+
+
+my $more_tests = 26;
#
# This file tries to test builtin override using CORE::GLOBAL
@@ -123,3 +152,7 @@ BEGIN { *OverridenPop::pop = sub { ::is( $_[0][0], "ok" ) }; }
};
is $@, '';
}
+
+
+is curr_test, $more_tests+$keyword_count+1, 'right number of tests';
+done_testing;
diff --git a/toke.c b/toke.c
index aaeff85a27..7690529af1 100644
--- a/toke.c
+++ b/toke.c
@@ -6459,7 +6459,8 @@ Perl_yylex(pTHX)
TOKEN(LABEL);
}
- if (tmp < 0) { /* second-class keyword? */
+ if (tmp < 0 /* second-class keyword? */
+ || FEATURE_IS_ENABLED("overrides")) {
GV *ogv = NULL; /* override (winner) */
GV *hgv = NULL; /* hidden (loser) */
if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
@@ -6493,7 +6494,7 @@ Perl_yylex(pTHX)
tmp = 0; /* any sub overrides "weak" keyword */
}
else { /* no override */
- tmp = -tmp;
+ if (tmp < 0) tmp = -tmp;
if (tmp == KEY_dump) {
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"dump() better written as CORE::dump()");