Front page | perl.perl5.porters |
Postings from December 2005
[PATCH] Feature bundle is now :5.10, and add -E switch
Thread Next
From:
Robin Houston
Date:
December 21, 2005 03:13
Subject:
[PATCH] Feature bundle is now :5.10, and add -E switch
This replaces the patches I posted last night. The "5.9.3" bundle
has been renamed "5.10", which I agree is better.
I've added a command-line switch -E, which is like -e except
that it implicitly enables all features in the main compilation
unit. I chose this because it makes it genuinely impossible to
use it for anything other than a throwaway one-liner (and it
should please the golfing fraternity).
(One technical point: I've added a new interpreter variable
in the middle of intrpvar.h, which obviously breaks binary
compatibility. But that's okay, right? It's easy to move it
to the end if not.)
Robin
--- perl-before/intrpvar.h 2005-12-16 21:32:51.000000000 +0000
+++ perl-after/intrpvar.h 2005-12-21 09:51:09.000000000 +0000
@@ -38,6 +38,7 @@
PERLVAR(Iminus_a, bool)
PERLVAR(Iminus_F, bool)
PERLVAR(Idoswitches, bool)
+PERLVAR(Iminus_E, bool)
/*
=head1 Global Variables
--- perl-before/lib/feature.pm 2005-12-19 18:19:57.000000000 +0000
+++ perl-after/lib/feature.pm 2005-12-21 09:36:04.000000000 +0000
@@ -8,6 +8,11 @@
switch => 'feature_switch',
"~~" => "feature_~~",
say => "feature_say",
+ err => "feature_err",
+);
+
+my %feature_bundle = (
+ "5.10" => [qw(switch ~~ say err)],
);
@@ -31,13 +36,13 @@
=head1 SYNOPSIS
- use feature 'switch';
+ use feature qw(switch say);
given ($foo) {
- when (1) { print "\$foo == 1\n" }
- when ([2,3]) { print "\$foo == 2 || \$foo == 3\n" }
- when (/^a[bc]d$/) { print "\$foo eq 'abd' || \$foo eq 'acd'\n" }
- when ($_ > 100) { print "\$foo > 100\n" }
- default { print "None of the above\n" }
+ when (1) { say "\$foo == 1" }
+ when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
+ when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
+ when ($_ > 100) { say "\$foo > 100" }
+ default { say "None of the above" }
}
=head1 DESCRIPTION
@@ -69,6 +74,22 @@
See L<perlfunc/say> for details.
+=head2 the 'err' feature
+
+C<use feature 'err'> tells the compiler to enable the C<err>
+operator from here to the end of the enclosing BLOCK.
+
+C<err> is a low-precedence variant of the C<//> operator:
+see C<perlop> for details.
+
+=head1 FEATURE BUNDLES
+
+It's possible to load a whole slew of features in one go, using
+a I<feature bundle>. The name of a feature bundle is prefixed with
+a colon, to distinguish it from an actual feature. At present, the
+only feature bundle is C<use feature ":5.10">, which is equivalent
+to C<use feature qw(switch ~~ say err)>.
+
=cut
sub import {
@@ -82,6 +103,16 @@
}
while (@_) {
my $name = shift(@_);
+ if ($name =~ /^:(.*)/) {
+ if (!exists $feature_bundle{$1}) {
+ require Carp;
+ Carp->import("croak");
+ croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
+ $1, $^V));
+ }
+ unshift @_, @{$feature_bundle{$1}};
+ next;
+ }
if (!exists $feature{$name}) {
require Carp;
Carp->import("croak");
@@ -96,7 +127,23 @@
my $class = shift;
# A bare C<no feature> should disable *all* features
- for my $name (@_) {
+ if(!@_) {
+ delete @^H{ values(%feature) };
+ return;
+ }
+
+ while (@_) {
+ my $name = shift;
+ if ($name =~ /^:(.*)/) {
+ if (!exists $feature_bundle{$1}) {
+ require Carp;
+ Carp->import("croak");
+ croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
+ $1, $^V));
+ }
+ unshift @_, @{$feature_bundle{$1}};
+ next;
+ }
if (!exists($feature{$name})) {
require Carp;
Carp->import("croak");
@@ -107,10 +154,6 @@
delete $^H{$feature{$name}};
}
}
-
- if(!@_) {
- delete @^H{ values(%feature) };
- }
}
1;
--- perl-before/MANIFEST 2005-12-19 16:28:40.000000000 +0000
+++ perl-after/MANIFEST 2005-12-20 19:59:18.000000000 +0000
@@ -2969,6 +2969,7 @@
t/lib/dprof/test8_t Perl code profiler tests
t/lib/dprof/test8_v Perl code profiler tests
t/lib/dprof/V.pm Perl code profiler tests
+t/lib/feature/err Tests for enabling/disabling err feature
t/lib/feature/nonesuch Tests for enabling/disabling nonexistent feature
t/lib/feature/say Tests for enabling/disabling say feature
t/lib/feature/smartmatch Tests for enabling/disabling smartmatch feature
--- perl-before/perl.c 2005-12-16 21:58:25.000000000 +0000
+++ perl-after/perl.c 2005-12-21 09:51:51.000000000 +0000
@@ -1665,6 +1665,9 @@
s++;
goto reswitch;
+ case 'E':
+ PL_minus_E = TRUE;
+ /* FALL THROUGH */
case 'e':
#ifdef MACOS_TRADITIONAL
/* ignore -e for Dev:Pseudo argument */
@@ -1683,7 +1686,7 @@
argc--,argv++;
}
else
- Perl_croak(aTHX_ "No code specified for -e");
+ Perl_croak(aTHX_ "No code specified for -%c", *s);
sv_catpv(PL_e_script, "\n");
break;
@@ -2825,6 +2828,7 @@
"-d[:debugger] run program under debugger",
"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
"-e program one line of program (several -e's allowed, omit programfile)",
+"-E program like -e, but enables all optional features",
"-f don't do $sitelib/sitecustomize.pl at startup",
"-F/pattern/ split() pattern for -a switch (//'s are optional)",
"-i[extension] edit <> files in place (makes backup if extension supplied)",
--- perl-before/perl_keyword.pl 2005-12-19 16:28:40.000000000 +0000
+++ perl-after/perl_keyword.pl 2005-12-20 19:46:02.000000000 +0000
@@ -43,6 +43,8 @@
break => 'switch',
say => 'say',
+
+ err => 'err',
);
my %pos = map { ($_ => 1) } @pos;
--- perl-before/pod/perlop.pod 2005-12-19 16:28:41.000000000 +0000
+++ perl-after/pod/perlop.pod 2005-12-20 19:45:41.000000000 +0000
@@ -838,7 +838,9 @@
Binary "err" is equivalent to C<//>--it's just like binary "or", except it tests
its left argument's definedness instead of its truth. There are two ways to
remember "err": either because many functions return C<undef> on an B<err>or,
-or as a sort of correction: C<$a=($b err 'default')>
+or as a sort of correction: C<$a=($b err 'default')>. This keyword
+is only available when the 'err' feature is enabled: see L<feature>
+for more information.
Binary "xor" returns the exclusive-OR of the two surrounding expressions.
It cannot short circuit, of course.
--- perl-before/pod/perlrun.pod 2005-11-30 21:42:17.000000000 +0000
+++ perl-after/pod/perlrun.pod 2005-12-21 10:01:41.000000000 +0000
@@ -15,7 +15,7 @@
S<[ B<-S> ]>
S<[ B<-x>[I<dir>] ]>
S<[ B<-i>[I<extension>] ]>
- S<[ B<-e> I<'command'> ] [ B<--> ] [ I<programfile> ] [ I<argument> ]...>
+ S<[ B<-eE> I<'command'> ] [ B<--> ] [ I<programfile> ] [ I<argument> ]...>
=head1 DESCRIPTION
@@ -30,7 +30,7 @@
=item 1.
-Specified line by line via B<-e> switches on the command line.
+Specified line by line via B<-e> or B<-E> switches on the command line.
=item 2.
@@ -448,6 +448,12 @@
commands may be given to build up a multi-line script. Make sure
to use semicolons where you would in a normal program.
+=item B<-E> I<commandline>
+X<-E>
+
+behaves just like B<-e>, except that it implicitly enables all
+optional features (in the main compilation unit). See L<feature>.
+
=item B<-f>
X<-f>
--- perl-before/sv.c 2005-12-20 20:21:06.000000000 +0000
+++ perl-after/sv.c 2005-12-21 09:51:41.000000000 +0000
@@ -10232,6 +10232,7 @@
PL_minus_p = proto_perl->Iminus_p;
PL_minus_l = proto_perl->Iminus_l;
PL_minus_a = proto_perl->Iminus_a;
+ PL_minus_E = proto_perl->Iminus_E;
PL_minus_F = proto_perl->Iminus_F;
PL_doswitches = proto_perl->Idoswitches;
PL_dowarn = proto_perl->Idowarn;
--- perl-before/t/lib/feature/err 1970-01-01 01:00:00.000000000 +0100
+++ perl-after/t/lib/feature/err 2005-12-20 20:18:58.000000000 +0000
@@ -0,0 +1,66 @@
+Check the lexical scoping of the err keyword.
+(The actual behaviour is tested in t/op/dor.t)
+
+__END__
+# No err; should be a syntax error.
+use warnings;
+my $undef err print "Hello!\n";
+EXPECT
+Bareword found where operator expected at - line 3, near "$undef err"
+ (Missing operator before err?)
+Unquoted string "err" may clash with future reserved word at - line 3.
+syntax error at - line 3, near "$undef err "
+Execution of - aborted due to compilation errors.
+########
+# With err, should work
+use warnings;
+use feature "err";
+my $undef err print "Hello", "world";
+EXPECT
+Helloworld
+########
+# With err, should work in eval too
+use warnings;
+use feature "err";
+eval q(my $undef err print "Hello", "world");
+EXPECT
+Helloworld
+########
+# feature out of scope; should be a syntax error.
+use warnings;
+{ use feature 'err'; }
+my $undef err print "Hello", "world";
+EXPECT
+Bareword found where operator expected at - line 4, near "$undef err"
+ (Missing operator before err?)
+Unquoted string "err" may clash with future reserved word at - line 4.
+syntax error at - line 4, near "$undef err "
+Execution of - aborted due to compilation errors.
+########
+# 'no feature' should work
+use warnings;
+use feature 'err';
+my $undef err print "Hello", "world";
+no feature;
+my $undef2 err "Hello", "world";
+EXPECT
+Bareword found where operator expected at - line 6, near "$undef2 err"
+ (Missing operator before err?)
+Unquoted string "err" may clash with future reserved word at - line 6.
+String found where operator expected at - line 6, near "err "Hello""
+ (Do you need to predeclare err?)
+syntax error at - line 6, near "$undef2 err "
+Execution of - aborted due to compilation errors.
+########
+# 'no feature "err"' should work too
+use warnings;
+use feature 'err';
+my $undef err print "Hello", "world";
+no feature 'err';
+$undef err print "Hello", "world";
+EXPECT
+Bareword found where operator expected at - line 6, near "$undef err"
+ (Missing operator before err?)
+Unquoted string "err" may clash with future reserved word at - line 6.
+syntax error at - line 6, near "$undef err "
+Execution of - aborted due to compilation errors.
--- perl-before/t/lib/feature/nonesuch 2005-12-19 16:28:41.000000000 +0000
+++ perl-after/t/lib/feature/nonesuch 2005-12-20 20:43:25.000000000 +0000
@@ -10,3 +10,13 @@
EXPECT
OPTIONS regex
^Feature "nonesuch" is not supported by Perl [v0-9.]+ at - line 1
+########
+use feature ":nonesuch";
+EXPECT
+OPTIONS regex
+^Feature bundle "nonesuch" is not supported by Perl [v0-9.]+ at - line 1
+########
+no feature ":nonesuch";
+EXPECT
+OPTIONS regex
+^Feature bundle "nonesuch" is not supported by Perl [v0-9.]+ at - line 1
--- perl-before/t/lib/warnings/op 2004-03-04 22:02:29.000000000 +0000
+++ perl-after/t/lib/warnings/op 2005-12-20 20:51:41.000000000 +0000
@@ -679,6 +679,7 @@
########
# op.c
use warnings 'misc';
+use feature 'err';
open FH, "<abc";
$_ = <FH> err $_ = 1;
($_ = <FH>) // ($_ = 1);
--- perl-before/toke.c 2005-12-20 20:21:07.000000000 +0000
+++ perl-after/toke.c 2005-12-21 10:04:05.000000000 +0000
@@ -459,7 +459,7 @@
#define FEATURE_IS_ENABLED(name, namelen) \
((0 != (PL_hints & HINT_LOCALIZE_HH)) \
- && feature_is_enabled(name, namelen))
+ && feature_is_enabled(name, namelen) )
/*
* S_feature_is_enabled
* Check whether the named feature is enabled.
@@ -2727,6 +2727,8 @@
sv_catpv(PL_linestr,"our @F=split(' ');");
}
}
+ if (PL_minus_E)
+ sv_catpv(PL_linestr,"use feature ':5.10';");
sv_catpvn(PL_linestr, "\n", 1);
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -4198,16 +4200,6 @@
{
tmp = 0; /* any sub overrides "weak" keyword */
}
- else if (gv && !gvp
- && tmp == -KEY_err
- && GvCVu(gv)
- && PL_expect != XOPERATOR
- && PL_expect != XTERMORDORDOR)
- {
- /* any sub overrides the "err" keyword, except when really an
- * operator is expected */
- tmp = 0;
- }
else { /* no override */
tmp = -tmp;
if (tmp == KEY_dump && ckWARN(WARN_MISC)) {
@@ -6098,7 +6090,7 @@
case 'r':
if (name[2] == 'r')
{ /* err */
- return -KEY_err;
+ return (FEATURE_IS_ENABLED("err", 3) ? -KEY_err : 0);
}
goto unknown;
--- perl-before/t/op/dor.t 2004-11-19 15:14:23.000000000 +0000
+++ perl-after/t/op/dor.t 2005-12-20 20:20:40.000000000 +0000
@@ -8,9 +8,10 @@
}
package main;
+use feature "err";
require './test.pl';
-plan( tests => 41 );
+plan( tests => 35 );
my($x);
@@ -82,15 +83,3 @@
is(0 // 2, 0, ' // : left-hand operand not optimized away');
is('' // 2, '', ' // : left-hand operand not optimized away');
is(undef // 2, 2, ' // : left-hand operand optimized away');
-
-# [perl #32347] err should be a weak keyword
-
-package weakerr;
-
-sub err { "<@_>" }
-::is( (shift() err 42), 42, 'err as an operator' );
-::is( (shift err 42), 42, 'err as an operator, with ambiguity' );
-::is( (err 2), "<2>", 'err as a function without parens' );
-::is( err(2, 3), "<2 3>", 'err as a function with parens' );
-::is( err(), "<>", 'err as a function without arguments' );
-::is( err, "<>", 'err as a function without parens' );
--- perl-before/t/run/switches.t 2005-12-12 12:24:34.000000000 +0000
+++ perl-after/t/run/switches.t 2005-12-21 10:30:53.000000000 +0000
@@ -1,7 +1,7 @@
#!./perl -w
# Tests for the command-line switches:
-# -0, -c, -l, -s, -m, -M, -V, -v, -h, -z, -i
+# -0, -c, -l, -s, -m, -M, -V, -v, -h, -z, -i, -E
# Some switches have their own tests, see MANIFEST.
BEGIN {
@@ -11,7 +11,7 @@
require "./test.pl";
-plan(tests => 26);
+plan(tests => 30);
use Config;
@@ -282,3 +282,26 @@
"foo yada dada:bada foo bing:king kong foo",
"-i backup file");
}
+
+# Tests for -E
+
+$r = runperl(
+ switches => [ '-E', '"say q(Hello, world!)"']
+);
+is( $r, "Hello, world!\n", "-E say" );
+
+
+$r = runperl(
+ switches => [ '-E', '"undef err say q(Hello, world!)"']
+);
+is( $r, "Hello, world!\n", "-E err" );
+
+$r = runperl(
+ switches => [ '-E', '"undef ~~ undef and say q(Hello, world!)"']
+);
+is( $r, "Hello, world!\n", "-E ~~" );
+
+$r = runperl(
+ switches => [ '-E', '"given(undef) {when(undef) { say q(Hello, world!)"}}']
+);
+is( $r, "Hello, world!\n", "-E given" );
Thread Next
-
[PATCH] Feature bundle is now :5.10, and add -E switch
by Robin Houston