In perl.git, the branch sprout/lexsub has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f9b8dcf824f1a95bcf4fe78f2b3d189a0068f430?hp=9cfcf6f58c571443c7eb08c7511ed0eda3aa3d4d>
- Log ----------------------------------------------------------------- commit f9b8dcf824f1a95bcf4fe78f2b3d189a0068f430 Author: Father Chrysostomos <[email protected]> Date: Mon Sep 10 23:09:53 2012 -0700 Disable lexsubs outside of experimental.pm M lib/experimental.pm M lib/experimental.t M perl.h M pod/perldiag.pod M t/cmd/lexsub.t M toke.c commit 408cebe5752bbec1d28fbf4a2688835dc1a6a2f9 Author: Father Chrysostomos <[email protected]> Date: Mon Sep 10 22:59:53 2012 -0700 experimental.pm M Porting/Maintainers.pl A lib/experimental.pm A lib/experimental.t ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 1 + lib/experimental.pm | 87 ++++++++++++++++++++++++++++++++++++++++++++++++ lib/experimental.t | 18 ++++++++++ perl.h | 3 ++ pod/perldiag.pod | 7 ++++ t/cmd/lexsub.t | 15 ++++++++- toke.c | 10 +++++ 7 files changed, 140 insertions(+), 1 deletions(-) create mode 100644 lib/experimental.pm create mode 100644 lib/experimental.t diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 80141be..ab616de 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -2198,6 +2198,7 @@ use File::Glob qw(:case); lib/dbm_filter_util.pl lib/deprecate.pm lib/dumpvar.{pl,t} + lib/experimental.{pm,t} lib/feature.{pm,t} lib/feature/ lib/filetest.{pm,t} diff --git a/lib/experimental.pm b/lib/experimental.pm new file mode 100644 index 0000000..970151a --- /dev/null +++ b/lib/experimental.pm @@ -0,0 +1,87 @@ +package experimental; + +$VERSION = '0.01'; + +my %features = ( + lexical_subs => 1, +); + +sub _croak { + require Carp; + Carp::croak($_[0]); +} + +sub _sanity { + shift; + if (!@_) { _croak ("No experimental features specified") } +} + +sub import { + &_sanity; + $^H{x} |= $features{$_} || _croak("Unknown experimental feature: $_") + for @_; +} + +sub unimport { + &_sanity; + $^H{x} |= $features{$_} || _croak("Unknown experimental feature: $_") + for @_; +} + +sub features { wantarray ? sort keys %features : keys %features } + +my(undef) = (undef); # return a true value + +__END__ + +=head1 NAME + +experimental - Enable experimental features + +=head1 SYNOPSIS + + use experimental 'lexical_subs'; + # lexical_subs feature enabled here + + { + no experimental 'lexical_subs'; + # temporarily disabled + } + + @available_experiments = experimental::features(); + +=head1 DESCRIPTION + +This pragma enables or disables experimental features in Perl. These are +features that may be modified or removed in future Perl versions. Some new +features are put here to be tested first before being upgraded to +"accepted" status. Feel free to use these features in your own personal +experiments, but beware of using them in production code! + +Not all experimental features are controlled by this pragma. Some are +always enabled, because they predate it. + +=head1 THE FEATURES + +There is currently only one. + +=over + +=item * lexical_subs + +This enables declaration of subroutines via C<my sub foo>, C<state sub foo> +and C<our sub foo> syntax. See perlsub/xxxx for details. + +=back + +=head1 USAGE + +To enable a feature, use C<use experimental 'I<feature_name>';>. To +disable it, use C<no> instead of C<use>. + +To obtain a list of features, call the C<experimental::features> function. +It returns a list in list context, or a count in scalar context. + +=head SEE ALSO + +L<feature>, L<perlexperiment> diff --git a/lib/experimental.t b/lib/experimental.t new file mode 100644 index 0000000..2b9a8c7 --- /dev/null +++ b/lib/experimental.t @@ -0,0 +1,18 @@ +use Test::More tests => 6; + +eval "#line 7 foo\nuse experimental;"; +like $@, qr/^No experimental features specified at foo line 7.\n/, + 'use experimental error'; +eval "#line 7 foo\nno experimental;"; +like $@, qr/^No experimental features specified at foo line 7.\n/, + 'no experimental error'; +eval "#line 7 foo\nuse experimental 'scientific';"; +like $@, qr/^Unknown experimental feature: scientific at foo line 7.\n/, + 'use experimental "foo" error'; +eval "#line 7 foo\nno experimental 'scientific';"; +like $@, qr/^Unknown experimental feature: scientific at foo line 7.\n/, + 'no experimental "foo" error'; + +is_deeply [experimental::features()], ['lexical_subs'], + 'experimental::features (list cx)'; +is experimental::features(), 1, 'experimental::features (scalar cx)'; diff --git a/perl.h b/perl.h index b299432..436f81d 100644 --- a/perl.h +++ b/perl.h @@ -4854,6 +4854,9 @@ typedef enum { #define HINT_SORT_MERGESORT 0x00000002 #define HINT_SORT_STABLE 0x00000100 /* sort styles (currently one) */ +/* Experimental feature hints in $^H{x} */ +#define HINT_X_LEXSUBS 0x1 + /* flags for PL_sawampersand */ #define SAWAMPERSAND_LEFT 1 /* saw $` */ diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 507288e..2f5271c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1867,6 +1867,13 @@ as a goto, or a loop control statement. (W exiting) You are exiting a substitution by unconventional means, such as a return, a goto, or a loop control statement. +=item Experimental "%s" subs not enabled + +(F) To use lexical subs, you must first enable them: + + use experimental 'lexical_subs'; + my sub foo { ... } + =item Explicit blessing to '' (assuming package main) (W misc) You are blessing a reference to a zero length string. This has diff --git a/t/cmd/lexsub.t b/t/cmd/lexsub.t index d7601b3..8564228 100644 --- a/t/cmd/lexsub.t +++ b/t/cmd/lexsub.t @@ -8,10 +8,23 @@ BEGIN { *bar::like = *like; } no warnings 'deprecated'; -plan 124; +plan 127; + +# -------------------- Errors with feature disabled -------------------- # + +eval "#line 8 foo\nmy sub foo"; +is $@, qq 'Experimental "my" subs not enabled at foo line 8.\n', + 'my sub unexperimental error'; +eval "#line 8 foo\nCORE::state sub foo"; +is $@, qq 'Experimental "state" subs not enabled at foo line 8.\n', + 'state sub unexperimental error'; +eval "#line 8 foo\nour sub foo"; +is $@, qq 'Experimental "our" subs not enabled at foo line 8.\n', + 'our sub unexperimental error'; # -------------------- our -------------------- # +use experimental 'lexical_subs'; { our sub foo { 42 } is foo, 42, 'calling our sub from same package'; diff --git a/toke.c b/toke.c index da207c3..00647a8 100644 --- a/toke.c +++ b/toke.c @@ -7836,7 +7836,17 @@ Perl_yylex(pTHX) #endif s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3)) + { + if (PL_hints & HINT_LOCALIZE_HH) { + SV * const h = + cop_hints_fetch_pvn(PL_curcop, "x", 1, 0, 0); + if (SvOK(h) && SvUV(h) & HINT_X_LEXSUBS) goto really_sub; + } + Perl_croak(aTHX_ "Experimental \"%s\" subs not enabled", + tmp == KEY_my ? "my" : + tmp == KEY_state ? "state" : "our"); + } PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len); if (!PL_in_my_stash) { char tmpbuf[1024]; -- Perl5 Master Repository
