Feature bundle is now :5.10, and add -E switch
authorRobin Houston <robin@cpan.org>
Wed, 21 Dec 2005 11:00:08 +0000 (11:00 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Wed, 21 Dec 2005 16:16:19 +0000 (16:16 +0000)
Message-ID: <20051221110008.GB25877@rpc142.cs.man.ac.uk>

p4raw-id: //depot/perl@26432

17 files changed:
MANIFEST
embedvar.h
global.sym
intrpvar.h
lib/feature.pm
perl.c
perl_keyword.pl
perlapi.h
pod/perlop.pod
pod/perlrun.pod
sv.c
t/lib/feature/err [new file with mode: 0644]
t/lib/feature/nonesuch
t/lib/warnings/op
t/op/dor.t
t/run/switches.t
toke.c

index 7260b76..37c8d4b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2969,6 +2969,7 @@ t/lib/dprof/test7_v               Perl code profiler tests
 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
index ee65be4..ca344b8 100644 (file)
 #define PL_maxsysfd            (vTHX->Imaxsysfd)
 #define PL_mess_sv             (vTHX->Imess_sv)
 #define PL_min_intro_pending   (vTHX->Imin_intro_pending)
+#define PL_minus_E             (vTHX->Iminus_E)
 #define PL_minus_F             (vTHX->Iminus_F)
 #define PL_minus_a             (vTHX->Iminus_a)
 #define PL_minus_c             (vTHX->Iminus_c)
 #define PL_Imaxsysfd           PL_maxsysfd
 #define PL_Imess_sv            PL_mess_sv
 #define PL_Imin_intro_pending  PL_min_intro_pending
+#define PL_Iminus_E            PL_minus_E
 #define PL_Iminus_F            PL_minus_F
 #define PL_Iminus_a            PL_minus_a
 #define PL_Iminus_c            PL_minus_c
index 376f23e..13dacb0 100644 (file)
@@ -74,6 +74,7 @@ Perl_sv_catpvf_mg_nocontext
 Perl_sv_setpvf_mg_nocontext
 Perl_fprintf_nocontext
 Perl_printf_nocontext
+Perl_gv_const_sv
 Perl_cv_const_sv
 Perl_cv_undef
 Perl_cx_dump
index e45e23d..04ea137 100644 (file)
@@ -38,6 +38,7 @@ PERLVAR(Iminus_l,     bool)
 PERLVAR(Iminus_a,      bool)
 PERLVAR(Iminus_F,      bool)
 PERLVAR(Idoswitches,   bool)
+PERLVAR(Iminus_E,      bool)
 
 /*
 =head1 Global Variables
index fe54994..345b288 100644 (file)
@@ -8,6 +8,11 @@ my %feature = (
     switch => 'feature_switch',
     "~~"   => "feature_~~",
     say    => "feature_say",
+    err    => "feature_err",
+);
+
+my %feature_bundle = (
+    "5.10" => [qw(switch ~~ say err)],
 );
 
 
@@ -31,13 +36,13 @@ feature - Perl pragma to enable new syntactic features
 
 =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 @@ C<say> function from here to the end of the enclosing BLOCK.
 
 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 @@ sub import {
     }
     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 @@ sub unimport {
     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 @@ sub unimport {
            delete $^H{$feature{$name}};
        }
     }
-
-    if(!@_) {
-       delete @^H{ values(%feature) };
-    }
 }
 
 1;
diff --git a/perl.c b/perl.c
index 525abef..133d3b5 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1665,6 +1665,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            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 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                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 @@ S_usage(pTHX_ const char *name)           /* XXX move this out into a module ? */
 "-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)",
index d0471f6..904bb59 100644 (file)
@@ -43,6 +43,8 @@ my %feature_kw = (
        break   => 'switch',
 
        say     => 'say',
+
+       err     => 'err',
        );
 
 my %pos = map { ($_ => 1) } @pos;
index 6f027b5..fff51f6 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -412,6 +412,8 @@ END_EXTERN_C
 #define PL_mess_sv             (*Perl_Imess_sv_ptr(aTHX))
 #undef  PL_min_intro_pending
 #define PL_min_intro_pending   (*Perl_Imin_intro_pending_ptr(aTHX))
+#undef  PL_minus_E
+#define PL_minus_E             (*Perl_Iminus_E_ptr(aTHX))
 #undef  PL_minus_F
 #define PL_minus_F             (*Perl_Iminus_F_ptr(aTHX))
 #undef  PL_minus_a
index db105e3..c2fba59 100644 (file)
@@ -838,7 +838,9 @@ Then again, you could always use parentheses.
 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.
index 06f9052..d497074 100644 (file)
@@ -15,7 +15,7 @@ B<perl>       S<[ B<-sTtuUWX> ]>
        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 @@ places:
 
 =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 @@ will not look for a filename in the argument list.  Multiple B<-e>
 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>
 
diff --git a/sv.c b/sv.c
index 4198a2b..0009471 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10232,6 +10232,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     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;
diff --git a/t/lib/feature/err b/t/lib/feature/err
new file mode 100644 (file)
index 0000000..638b5a6
--- /dev/null
@@ -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.
index 1de44f6..0de975a 100644 (file)
@@ -10,3 +10,13 @@ no feature "nonesuch";
 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
index c39a7b2..ca92412 100644 (file)
@@ -679,6 +679,7 @@ Value of readdir() operator can be "0"; test with defined() at - line 4.
 ########
 # op.c
 use warnings 'misc';
+use feature 'err';
 open FH, "<abc";
 $_ = <FH> err $_ = 1;
 ($_ = <FH>) // ($_ = 1);
index 079631a..04e0f7d 100644 (file)
@@ -8,9 +8,10 @@ BEGIN {
 }
 
 package main;
+use feature "err";
 require './test.pl';
 
-plan( tests => 41 );
+plan( tests => 35 );
 
 my($x);
 
@@ -82,15 +83,3 @@ like( $@, qr/^Search pattern not terminated/ );
 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' );
index a63c54b..f654486 100644 (file)
@@ -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 @@ BEGIN {
 
 require "./test.pl";
 
-plan(tests => 26);
+plan(tests => 30);
 
 use Config;
 
@@ -282,3 +282,26 @@ __EOF__
        "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" );
diff --git a/toke.c b/toke.c
index 0aba721..aed01c0 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -459,7 +459,7 @@ S_missingterm(pTHX_ char *s)
 
 #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 @@ Perl_yylex(pTHX)
                        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 @@ Perl_yylex(pTHX)
            {
                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 @@ Perl_keyword (pTHX_ const char *name, I32 len)
             case 'r':
               if (name[2] == 'r')
               {                                   /* err        */
-                return -KEY_err;
+                return (FEATURE_IS_ENABLED("err", 3) ? -KEY_err : 0);
               }
 
               goto unknown;