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
#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
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
PERLVAR(Iminus_a, bool)
PERLVAR(Iminus_F, bool)
PERLVAR(Idoswitches, bool)
+PERLVAR(Iminus_E, bool)
/*
=head1 Global Variables
switch => 'feature_switch',
"~~" => "feature_~~",
say => "feature_say",
+ err => "feature_err",
+);
+
+my %feature_bundle = (
+ "5.10" => [qw(switch ~~ say err)],
);
=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
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 {
}
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");
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");
delete $^H{$feature{$name}};
}
}
-
- if(!@_) {
- delete @^H{ values(%feature) };
- }
}
1;
s++;
goto reswitch;
+ case 'E':
+ PL_minus_E = TRUE;
+ /* FALL THROUGH */
case 'e':
#ifdef MACOS_TRADITIONAL
/* ignore -e for Dev:Pseudo argument */
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;
"-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)",
break => 'switch',
say => 'say',
+
+ err => 'err',
);
my %pos = map { ($_ => 1) } @pos;
#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
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.
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
=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.
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>
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;
--- /dev/null
+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.
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
########
# op.c
use warnings 'misc';
+use feature 'err';
open FH, "<abc";
$_ = <FH> err $_ = 1;
($_ = <FH>) // ($_ = 1);
}
package main;
+use feature "err";
require './test.pl';
-plan( tests => 41 );
+plan( tests => 35 );
my($x);
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 -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 {
require "./test.pl";
-plan(tests => 26);
+plan(tests => 30);
use Config;
"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" );
#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.
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);
{
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)) {
case 'r':
if (name[2] == 'r')
{ /* err */
- return -KEY_err;
+ return (FEATURE_IS_ENABLED("err", 3) ? -KEY_err : 0);
}
goto unknown;
projects / p5sagit/p5-mst-13.2.git / commitdiff