In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/b92342550433b215a30d5d4b9bfe55321c69f8ac?hp=1c2511e0acc5a19f9f52fb2be58a4e2750213e6f>
- Log -----------------------------------------------------------------
commit b92342550433b215a30d5d4b9bfe55321c69f8ac
Author: Aaron Crane <a...@cpan.org>
Date: Thu Jun 25 13:50:43 2015 +0100
Eliminate repetitious wording in perldiag
M op.c
M pod/perldiag.pod
commit 262309092c2de925e7ae4a527174f8dc2a0ec7b7
Author: Aaron Crane <a...@cpan.org>
Date: Thu Jun 11 17:24:13 2015 +0100
Delete experimental autoderef feature
M doop.c
M ext/Opcode/Opcode.pm
M lib/B/Deparse-core.t
M lib/B/Deparse.t
M lib/B/Op_private.pm
M lib/locale.t
M lib/warnings.pm
M op.c
M opcode.h
M opnames.h
M pod/perldelta.pod
M pod/perldiag.pod
M pod/perlfunc.pod
M pod/perlsub.pod
M pp.c
M pp_proto.h
M regen/op_private
M regen/opcode.pl
M regen/opcodes
M regen/warnings.pl
M t/lib/croak/op
M t/lib/warnings/op
M t/op/coresubs.t
M t/op/cproto.t
M t/op/kvaslice.t
M t/op/kvhslice.t
M t/op/push.t
M t/op/smartkve.t
M t/op/splice.t
M t/op/tie_fetch_count.t
M t/op/unshift.t
M warnings.h
commit de6cb0abd243e5772b9783a2cbeef5755a8267d6
Author: Aaron Crane <a...@cpan.org>
Date: Wed Jun 24 21:17:17 2015 +0100
regen/regcharclass.pl: avoid autoderef feature
M regcharclass.h
M regen/regcharclass.pl
commit ce0b42da7302bf923a6e4080a343f168e4b3b526
Author: Aaron Crane <a...@cpan.org>
Date: Wed Jun 24 21:14:49 2015 +0100
Porting/corelist.pl: avoid autoderef feature
M Porting/corelist.pl
-----------------------------------------------------------------------
Summary of changes:
Porting/corelist.pl | 25 ++--
doop.c | 4 +-
ext/Opcode/Opcode.pm | 4 +-
lib/B/Deparse-core.t | 41 +++--
lib/B/Deparse.t | 13 +-
lib/B/Op_private.pm | 7 +-
lib/locale.t | 12 +-
lib/warnings.pm | 89 ++++++-----
op.c | 57 +++----
opcode.h | 27 +---
opnames.h | 29 ++--
pod/perldelta.pod | 8 +
pod/perldiag.pod | 79 +---------
pod/perlfunc.pod | 124 +++------------
pod/perlsub.pod | 10 +-
pp.c | 43 +-----
pp_proto.h | 1 -
regcharclass.h | 2 +-
regen/op_private | 2 +-
regen/opcode.pl | 1 -
regen/opcodes | 5 -
regen/regcharclass.pl | 5 +-
regen/warnings.pl | 4 +-
t/lib/croak/op | 12 +-
t/lib/warnings/op | 56 -------
t/op/coresubs.t | 12 --
t/op/cproto.t | 16 +-
t/op/kvaslice.t | 20 +--
t/op/kvhslice.t | 20 +--
t/op/push.t | 38 +----
t/op/smartkve.t | 400 ++++---------------------------------------------
t/op/splice.t | 4 -
t/op/tie_fetch_count.t | 10 +-
t/op/unshift.t | 35 +----
warnings.h | 23 ++-
35 files changed, 270 insertions(+), 968 deletions(-)
diff --git a/Porting/corelist.pl b/Porting/corelist.pl
index ce4ff2b..545a102 100755
--- a/Porting/corelist.pl
+++ b/Porting/corelist.pl
@@ -10,7 +10,6 @@
use autodie;
use strict;
use warnings;
-no warnings 'experimental::autoderef';
use File::Find;
use ExtUtils::MM_Unix;
use version;
@@ -155,14 +154,14 @@ my $delta_data = make_corelist_delta(
my $versions_in_release = " " . $perl_vnum . " => {\n";
$versions_in_release .= " delta_from => $delta_data->{delta_from},\n";
$versions_in_release .= " changed => {\n";
-foreach my $key (sort keys $delta_data->{changed}) {
+foreach my $key (sort keys $delta_data->{changed}->%*) {
$versions_in_release .= sprintf " %-24s=> %s,\n", "'$key'",
defined $delta_data->{changed}{$key} ? "'"
. $delta_data->{changed}{$key} . "'" : "undef";
}
$versions_in_release .= " },\n";
$versions_in_release .= " removed => {\n";
-for my $key (sort keys($delta_data->{removed} || {})) {
+for my $key (sort keys %{ $delta_data->{removed} || {} }) {
$versions_in_release .= sprintf " %-24s=> %s,\n", "'$key'", 1;
}
$versions_in_release .= " }\n";
@@ -261,14 +260,14 @@ $corelist =~ s/^%upstream .*? ;$/$upstream_stanza/ismx;
my $deprecated_stanza = " " . $perl_vnum . " => {\n";
$deprecated_stanza .= " delta_from => $delta_data->{delta_from},\n";
$deprecated_stanza .= " changed => {\n";
- foreach my $key (sort keys $delta_data->{changed}) {
+ foreach my $key (sort keys $delta_data->{changed}->%*) {
$deprecated_stanza .= sprintf " %-24s=> %s,\n", "'$key'",
defined $delta_data->{changed}{$key} ? "'"
. $delta_data->{changed}{$key} . "'" : "undef";
}
$deprecated_stanza .= " },\n";
$deprecated_stanza .= " removed => {\n";
- for my $key (sort keys($delta_data->{removed} || {})) {
+ for my $key (sort keys %{ $delta_data->{removed} || {} }) {
$deprecated_stanza .= sprintf " %-24s=> %s,\n", "'$key'", 1;
}
$deprecated_stanza .= " }\n";
@@ -312,14 +311,14 @@ my $delta_utils = make_coreutils_delta($perl_vnum,
\%utils);
my $utilities_in_release = " " . $perl_vnum . " => {\n";
$utilities_in_release .= " delta_from => $delta_utils->{delta_from},\n";
$utilities_in_release .= " changed => {\n";
-foreach my $key (sort keys $delta_utils->{changed}) {
+foreach my $key (sort keys $delta_utils->{changed}->%*) {
$utilities_in_release .= sprintf " %-24s=> %s,\n", "'$key'",
defined $delta_utils->{changed}{$key} ? "'"
. $delta_utils->{changed}{$key} . "'" : "undef";
}
$utilities_in_release .= " },\n";
$utilities_in_release .= " removed => {\n";
-for my $key (sort keys($delta_utils->{removed} || {})) {
+for my $key (sort keys %{ $delta_utils->{removed} || {} }) {
$utilities_in_release .= sprintf " %-24s=> %s,\n", "'$key'", 1;
}
$utilities_in_release .= " }\n";
@@ -375,8 +374,8 @@ sub make_corelist_delta {
}
my $smallest = (sort {
- ((keys($deltas{$a}->{changed}) + keys($deltas{$a}->{removed})) <=>
- (keys($deltas{$b}->{changed}) + keys($deltas{$b}->{removed}))) ||
+ ((keys($deltas{$a}->{changed}->%*) + keys($deltas{$a}->{removed}->%*))
<=>
+ (keys($deltas{$b}->{changed}->%*) + keys($deltas{$b}->{removed}->%*)))
||
$b <=> $a
} keys %deltas)[0];
@@ -409,8 +408,8 @@ sub make_coreutils_delta {
}
my $smallest = (sort {
- ((keys($deltas{$a}->{changed}) + keys($deltas{$a}->{removed})) <=>
- (keys($deltas{$b}->{changed}) + keys($deltas{$b}->{removed}))) ||
+ ((keys($deltas{$a}->{changed}->%*) + keys($deltas{$a}->{removed}->%*))
<=>
+ (keys($deltas{$b}->{changed}->%*) + keys($deltas{$b}->{removed}->%*)))
||
$b <=> $a
} keys %deltas)[0];
@@ -426,13 +425,13 @@ sub calculate_delta {
my($from, $to) = @_;
my(%changed, %removed);
- for my $package(keys $from) {
+ for my $package(keys %$from) {
if(not exists $to->{$package}) {
$removed{$package} = 1;
}
}
- for my $package(keys $to) {
+ for my $package(keys %$to) {
if(!exists $from->{$package}
|| (defined $from->{$package} && !defined $to->{$package})
|| (!defined $from->{$package} && defined $to->{$package})
diff --git a/doop.c b/doop.c
index c6ee847..22e614a 100644
--- a/doop.c
+++ b/doop.c
@@ -1223,8 +1223,8 @@ Perl_do_kv(pTHX)
const I32 gimme = GIMME_V;
const I32 dokv = (PL_op->op_type == OP_RV2HV || PL_op->op_type ==
OP_PADHV);
/* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
- const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS || PL_op->op_type
== OP_RKEYS);
- const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES ||
PL_op->op_type == OP_RVALUES);
+ const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS);
+ const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES);
(void)hv_iterinit(keys); /* always reset iterator regardless */
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index c9a3f15..78ffd54 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -6,7 +6,7 @@ use strict;
our($VERSION, @ISA, @EXPORT_OK);
-$VERSION = "1.32";
+$VERSION = "1.33";
use Carp;
use Exporter ();
@@ -312,7 +312,7 @@ invert_opset function.
av2arylen
rv2hv helem hslice kvhslice each values keys exists delete
- aeach akeys avalues reach rvalues rkeys multideref
+ aeach akeys avalues multideref
preinc i_preinc predec i_predec postinc i_postinc
postdec i_postdec int hex oct abs pow multiply i_multiply
diff --git a/lib/B/Deparse-core.t b/lib/B/Deparse-core.t
index 981c74e..b97cc71 100644
--- a/lib/B/Deparse-core.t
+++ b/lib/B/Deparse-core.t
@@ -36,11 +36,10 @@ BEGIN {
use strict;
use Test::More;
-plan tests => 4006;
+plan tests => 3886;
use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature
# logic to add CORE::
-no warnings 'experimental::autoderef';
use B::Deparse;
my $deparse = new B::Deparse;
@@ -103,7 +102,6 @@ sub testit {
unless ($got_text =~ /
package (?:lexsub)?test;
- BEGIN \{\$\{\^WARNING_BITS} = "[^"]*"}
use strict 'refs', 'subs';
use feature [^\n]+
\Q$vars\E\(\) = (.*)
@@ -252,6 +250,7 @@ testit do => 'do { 1 };',
"do {\n 1\n };";
testit each => 'CORE::each %bar;';
+testit each => 'CORE::each @foo;';
testit eof => 'CORE::eof();';
@@ -271,17 +270,32 @@ testit glob => 'CORE::glob $a;',
'CORE::glob($a);';
testit grep => 'CORE::grep { $a } $b, $c', 'grep({$a;} $b, $c);';
testit keys => 'CORE::keys %bar;';
+testit keys => 'CORE::keys @bar;';
testit map => 'CORE::map { $a } $b, $c', 'map({$a;} $b, $c);';
testit not => '3 unless CORE::not $a && $b;';
+testit pop => 'CORE::pop @foo;';
+
+testit push => 'CORE::push @foo;', 'CORE::push(@foo);';
+testit push => 'CORE::push @foo, 1;', 'CORE::push(@foo, 1);';
+testit push => 'CORE::push @foo, 1, 2;', 'CORE::push(@foo, 1, 2);';
+
testit readline => 'CORE::readline $a . $b;';
testit readpipe => 'CORE::readpipe $a + $b;';
testit reverse => 'CORE::reverse sort(@foo);';
+testit shift => 'CORE::shift @foo;';
+
+testit splice => q{CORE::splice @foo;},
q{CORE::splice(@foo);};
+testit splice => q{CORE::splice @foo, 0;}, q{CORE::splice(@foo,
0);};
+testit splice => q{CORE::splice @foo, 0, 1;}, q{CORE::splice(@foo,
0, 1);};
+testit splice => q{CORE::splice @foo, 0, 1, 'a';}, q{CORE::splice(@foo,
0, 1, 'a');};
+testit splice => q{CORE::splice @foo, 0, 1, 'a', 'b';}, q{CORE::splice(@foo,
0, 1, 'a', 'b');};
+
# note that the test does '() = split...' which is why the
# limit is optimised to 1
testit split => 'split;', q{split(' ', $_, 1);};
@@ -298,7 +312,12 @@ testit sub => 'CORE::sub { $a, $b }',
testit system => 'CORE::system($foo $bar);';
+testit unshift => 'CORE::unshift @foo;', 'CORE::unshift(@foo);';
+testit unshift => 'CORE::unshift @foo, 1;', 'CORE::unshift(@foo, 1);';
+testit unshift => 'CORE::unshift @foo, 1, 2;', 'CORE::unshift(@foo, 1, 2);';
+
testit values => 'CORE::values %bar;';
+testit values => 'CORE::values @foo;';
# XXX These are deparsed wrapped in parens.
@@ -463,7 +482,7 @@ defined 01 $+
die @ p1
# do handled specially
# dump handled specially
-each 1 - # also tested specially
+# each handled specially
endgrent 0 -
endhostent 0 -
endnetent 0 -
@@ -522,7 +541,7 @@ index 23 p
int 01 $
ioctl 3 p
join 13 p
-keys 1 - # also tested specially
+# keys handled specially
kill 123 p
# last handled specially
lc 01 $
@@ -555,12 +574,12 @@ ord 01 $
our 123 p+ # skip with 0 args, as our() => ()
pack 123 p
pipe 2 p
-pop 01 1
+pop 0 1 # also tested specially
pos 01 $+
print @ p$+
printf @ p$+
prototype 1 +
-push 123 p
+# push handled specially
quotemeta 01 $
rand 01 -
read 34 p
@@ -601,7 +620,7 @@ setprotoent 1 -
setpwent 0 -
setservent 1 -
setsockopt 4 p
-shift 01 1
+shift 0 1 # also tested specially
shmctl 3 p
shmget 3 p
shmread 4 p
@@ -613,7 +632,7 @@ socket 4 p
socketpair 5 p
sort @ p1+
# split handled specially
-splice 12345 p
+# splice handled specially
sprintf 123 p
sqrt 01 $
srand 01 -
@@ -642,10 +661,10 @@ umask 01 -
undef 01 +
unlink @ p$
unpack 12 p$
-unshift 1 p
+# unshift handled specially
untie 1 -
utime @ p1
-values 1 - # also tested specially
+# values handled specially
vec 3 p
wait 0 -
waitpid 2 p
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 2fb5b75..b4874a4 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -1365,6 +1365,7 @@ tr/a/b/r + $a =~ tr/p/q/r;
<a,>;
####
# [perl #91008]
+# SKIP ?$] >= 5.023 && "autoderef deleted in this Perl version"
# CONTEXT no warnings 'experimental::autoderef';
each $@;
keys $~;
@@ -1871,12 +1872,12 @@ my sub f {}
print f();
>>>>
use feature 'lexical_subs';
-BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x55\x01"}
+BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x55"}
my sub f {
- BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x01"}
+ BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
}
-BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x01"}
+BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
print f();
####
# SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version"
@@ -1887,13 +1888,13 @@ state sub f {}
print f();
>>>>
use feature 'lexical_subs';
-BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x55\x01"}
+BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x55"}
CORE::state sub f {
- BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x01"}
+ BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
use feature 'state';
}
-BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x01"}
+BEGIN {${^WARNING_BITS} =
"\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
use feature 'state';
print f();
####
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 512f66a..c9db867 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -137,7 +137,7 @@ $bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem
multideref);
$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter
entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv
padrange padsv pushmark refassign rv2av r ... [18 chars truncated]
$bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign);
$bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign);
-$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem
hslice keys kvaslice kvhslice multideref padav padhv pos rkeys rv2av rv2gv
rv2hv substr vec);
+$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem
hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv
substr vec);
$bits{$_}{4} = 'OPpMAYBE_TRUEBOOL' for qw(padhv rv2hv);
$bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray);
$bits{$_}{5} = 'OPpOPEN_IN_CRLF' for qw(backtick open);
@@ -452,7 +452,6 @@ $bits{prototype}{0} = $bf[0];
$bits{quotemeta}{0} = $bf[0];
@{$bits{rand}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
$bits{range}{0} = $bf[0];
-$bits{reach}{0} = $bf[0];
@{$bits{read}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
$bits{readdir}{0} = $bf[0];
$bits{readline}{0} = $bf[0];
@@ -473,14 +472,12 @@ $bits{require}{0} = $bf[0];
$bits{rewinddir}{0} = $bf[0];
@{$bits{right_shift}}{1,0} = ($bf[1], $bf[1]);
@{$bits{rindex}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
-$bits{rkeys}{0} = $bf[0];
$bits{rmdir}{0} = $bf[0];
$bits{rv2av}{0} = $bf[0];
@{$bits{rv2cv}}{7,5,0} = ('OPpENTERSUB_NOPAREN', 'OPpMAY_RETURN_CONSTANT',
$bf[0]);
@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[6], $bf[6],
'OPpDONT_INIT_GV', $bf[0]);
$bits{rv2hv}{0} = $bf[0];
@{$bits{rv2sv}}{5,4,0} = ($bf[6], $bf[6], $bf[0]);
-$bits{rvalues}{0} = $bf[0];
@{$bits{sassign}}{7,6,1,0} = ('OPpASSIGN_CV_TO_GV', 'OPpASSIGN_BACKWARDS',
$bf[1], $bf[1]);
@{$bits{sbit_and}}{1,0} = ($bf[1], $bf[1]);
@{$bits{sbit_or}}{1,0} = ($bf[1], $bf[1]);
@@ -775,7 +772,7 @@ our %ops_using = (
OPpLVAL_DEFER => [qw(aelem helem multideref)],
OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter
entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv
padrange padsv pushmark refassign rv2av rv2 ... [17 chars truncated]
OPpLVREF_ELEM => [qw(lvref refassign)],
- OPpMAYBE_LVSUB => [qw(aassign aelem aslice av2arylen helem
hslice keys kvaslice kvhslice multideref padav padhv pos rkeys rv2av rv2gv
rv2hv substr vec)],
+ OPpMAYBE_LVSUB => [qw(aassign aelem aslice av2arylen helem
hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv
substr vec)],
OPpMAYBE_TRUEBOOL => [qw(padhv rv2hv)],
OPpMULTIDEREF_DELETE => [qw(multideref)],
OPpOFFBYONE => [qw(caller runcv wantarray)],
diff --git a/lib/locale.t b/lib/locale.t
index 3f37457..1ebd0ce 100644
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -29,7 +29,7 @@ BEGIN {
}
use strict;
-use feature 'fc';
+use feature 'fc', 'postderef';
# =1 adds debugging output; =2 increases the verbosity somewhat
my $debug = $ENV{PERL_DEBUG_FULL_TEST} // 0;
@@ -2264,14 +2264,14 @@ foreach $test_num
($first_locales_test_number..$final_locales_test_number) {
if (($Okay{$test_num} || $Known_bad_locale{$test_num})
&& grep { $_ == $test_num } keys %problematical_tests)
{
- no warnings 'experimental::autoderef';
+ no warnings 'experimental::postderef';
# Don't count the known-bad failures when calculating the
# percentage that fail.
my $known_failures = (exists $Known_bad_locale{$test_num})
- ? scalar(keys $Known_bad_locale{$test_num})
+ ? scalar(keys
$Known_bad_locale{$test_num}->%*)
: 0;
- my $adjusted_failures = scalar(keys $Problem{$test_num})
+ my $adjusted_failures = scalar(keys $Problem{$test_num}->%*)
- $known_failures;
# Specially handle failures where only known-bad locales fail.
@@ -2279,7 +2279,7 @@ foreach $test_num
($first_locales_test_number..$final_locales_test_number) {
if ($adjusted_failures <= 0) {
print "not ok $test_num $test_names{$test_num} # TODO fails
only on ",
"known bad
locales: ",
- join " ", keys $Known_bad_locale{$test_num}, "\n";
+ join " ", keys $Known_bad_locale{$test_num}->%*, "\n";
next TEST_NUM;
}
@@ -2298,7 +2298,7 @@ foreach $test_num
($first_locales_test_number..$final_locales_test_number) {
}
if ($debug) {
print "# $percent_fail% of locales (",
- scalar(keys $Problem{$test_num}),
+ scalar(keys $Problem{$test_num}->%*),
" of ",
scalar(@Locale),
") fail the above test (TODO cut-off is ",
diff --git a/lib/warnings.pm b/lib/warnings.pm
index e47ced4..332f7c1 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -5,7 +5,7 @@
package warnings;
-our $VERSION = '1.32';
+our $VERSION = '1.33';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
@@ -80,24 +80,23 @@ our %Offsets = (
'experimental::smartmatch' => 110,
# Warnings Categories added in Perl 5.019
- 'experimental::autoderef' => 112,
- 'experimental::postderef' => 114,
- 'experimental::signatures' => 116,
- 'syscalls' => 118,
+ 'experimental::postderef' => 112,
+ 'experimental::signatures' => 114,
+ 'syscalls' => 116,
# Warnings Categories added in Perl 5.021
- 'experimental::bitwise' => 120,
- 'experimental::const_attr' => 122,
- 'experimental::re_strict' => 124,
- 'experimental::refaliasing' => 126,
- 'experimental::win32_perlio' => 128,
- 'locale' => 130,
- 'missing' => 132,
- 'redundant' => 134,
+ 'experimental::bitwise' => 118,
+ 'experimental::const_attr' => 120,
+ 'experimental::re_strict' => 122,
+ 'experimental::refaliasing' => 124,
+ 'experimental::win32_perlio' => 126,
+ 'locale' => 128,
+ 'missing' => 130,
+ 'redundant' => 132,
);
our %Bits = (
- 'all' =>
"\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", #
[0..67]
+ 'all' =>
"\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", #
[0..66]
'ambiguous' =>
"\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
'bareword' =>
"\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
'closed' =>
"\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -107,30 +106,29 @@ our %Bits = (
'digit' =>
"\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
'exec' =>
"\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' =>
"\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'experimental' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x15\x55\x01", #
[51..58,60..64]
- 'experimental::autoderef' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [56]
- 'experimental::bitwise' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [60]
- 'experimental::const_attr' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [61]
+ 'experimental' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x45\x55\x00", #
[51..57,59..63]
+ 'experimental::bitwise' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [59]
+ 'experimental::const_attr' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [60]
'experimental::lexical_subs' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [52]
'experimental::lexical_topic' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [53]
- 'experimental::postderef' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [57]
- 'experimental::re_strict' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [62]
- 'experimental::refaliasing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [63]
+ 'experimental::postderef' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [56]
+ 'experimental::re_strict' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [61]
+ 'experimental::refaliasing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [62]
'experimental::regex_sets' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [54]
- 'experimental::signatures' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [58]
+ 'experimental::signatures' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [57]
'experimental::smartmatch' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [55]
- 'experimental::win32_perlio' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [64]
+ 'experimental::win32_perlio' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [63]
'glob' =>
"\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
'illegalproto' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [47]
'imprecision' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [46]
'inplace' =>
"\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
'internal' =>
"\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
- 'io' =>
"\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", #
[5..11,59]
+ 'io' =>
"\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", #
[5..11,58]
'layer' =>
"\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
- 'locale' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [65]
+ 'locale' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [64]
'malloc' =>
"\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
'misc' =>
"\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
- 'missing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [66]
+ 'missing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [65]
'newline' =>
"\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
'non_unicode' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [48]
'nonchar' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [49]
@@ -147,7 +145,7 @@ our %Bits = (
'qw' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [36]
'recursion' =>
"\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
'redefine' =>
"\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
- 'redundant' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [67]
+ 'redundant' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [66]
'regexp' =>
"\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
'reserved' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [37]
'semicolon' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [38]
@@ -156,7 +154,7 @@ our %Bits = (
'substr' =>
"\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
'surrogate' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [50]
'syntax' =>
"\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00\x00\x00\x00", #
[28..38,47]
- 'syscalls' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [59]
+ 'syscalls' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [58]
'taint' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [39]
'threads' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [40]
'uninitialized' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [41]
@@ -168,7 +166,7 @@ our %Bits = (
);
our %DeadBits = (
- 'all' =>
"\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", #
[0..67]
+ 'all' =>
"\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", #
[0..66]
'ambiguous' =>
"\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
'bareword' =>
"\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
'closed' =>
"\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -178,30 +176,29 @@ our %DeadBits = (
'digit' =>
"\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
'exec' =>
"\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' =>
"\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'experimental' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x2a\xaa\x02", #
[51..58,60..64]
- 'experimental::autoderef' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [56]
- 'experimental::bitwise' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [60]
- 'experimental::const_attr' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [61]
+ 'experimental' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x8a\xaa\x00", #
[51..57,59..63]
+ 'experimental::bitwise' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [59]
+ 'experimental::const_attr' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [60]
'experimental::lexical_subs' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [52]
'experimental::lexical_topic' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [53]
- 'experimental::postderef' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [57]
- 'experimental::re_strict' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [62]
- 'experimental::refaliasing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [63]
+ 'experimental::postderef' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [56]
+ 'experimental::re_strict' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [61]
+ 'experimental::refaliasing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [62]
'experimental::regex_sets' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [54]
- 'experimental::signatures' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [58]
+ 'experimental::signatures' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [57]
'experimental::smartmatch' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [55]
- 'experimental::win32_perlio' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [64]
+ 'experimental::win32_perlio' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [63]
'glob' =>
"\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
'illegalproto' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [47]
'imprecision' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [46]
'inplace' =>
"\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
'internal' =>
"\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
- 'io' =>
"\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", #
[5..11,59]
+ 'io' =>
"\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", #
[5..11,58]
'layer' =>
"\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
- 'locale' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [65]
+ 'locale' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [64]
'malloc' =>
"\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
'misc' =>
"\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
- 'missing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [66]
+ 'missing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [65]
'newline' =>
"\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
'non_unicode' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [48]
'nonchar' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [49]
@@ -218,7 +215,7 @@ our %DeadBits = (
'qw' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [36]
'recursion' =>
"\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
'redefine' =>
"\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
- 'redundant' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [67]
+ 'redundant' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [66]
'regexp' =>
"\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
'reserved' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [37]
'semicolon' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [38]
@@ -227,7 +224,7 @@ our %DeadBits = (
'substr' =>
"\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
'surrogate' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [50]
'syntax' =>
"\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00\x00\x00\x00", #
[28..38,47]
- 'syscalls' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [59]
+ 'syscalls' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [58]
'taint' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [39]
'threads' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [40]
'uninitialized' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [41]
@@ -240,8 +237,8 @@ our %DeadBits = (
# These are used by various things, including our own tests
our $NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
-our $DEFAULT =
"\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x15\x55\x05", #
[2,56,60,61,52,53,57,62,63,54,58,55,64,4,65,22,23,25]
-our $LAST_BIT = 136 ;
+our $DEFAULT =
"\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x45\x55\x01", #
[2,59,60,52,53,56,61,62,54,57,55,63,4,64,22,23,25]
+our $LAST_BIT = 134 ;
our $BYTES = 17 ;
our $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
@@ -726,8 +723,6 @@ The current hierarchy is:
|
+- experimental --+
| |
- | +- experimental::autoderef
- | |
| +- experimental::bitwise
| |
| +- experimental::const_attr
diff --git a/op.c b/op.c
index 539d101..9d3d0fa 100644
--- a/op.c
+++ b/op.c
@@ -1620,9 +1620,6 @@ S_scalar_slice_warning(pTHX_ const OP *o)
case OP_LOCALTIME:
case OP_GMTIME:
case OP_ENTEREVAL:
- case OP_REACH:
- case OP_RKEYS:
- case OP_RVALUES:
return;
}
@@ -2998,7 +2995,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
break;
case OP_KEYS:
- case OP_RKEYS:
if (type != OP_SASSIGN && type != OP_LEAVESUBLV)
goto nomod;
goto lvalue_func;
@@ -9974,17 +9970,13 @@ Perl_ck_fun(pTHX_ OP *o)
|| SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV )
)
bad_type_pv(numargs, "array", o, kid);
- /* Defer checks to run-time if we have a scalar arg */
- if (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV)
- op_lvalue(kid, type);
- else {
- scalar(kid);
- /* diag_listed_as: push on reference is experimental */
- Perl_ck_warner_d(aTHX_
- packWARN(WARN_EXPERIMENTAL__AUTODEREF),
- "%s on reference is experimental",
- PL_op_desc[type]);
+ else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) {
+ yyerror_pv(Perl_form(aTHX_ "Experimental %s on scalar is
now forbidden",
+ PL_op_desc[type]), 0);
}
+ else {
+ op_lvalue(kid, type);
+ }
break;
case OA_HVREF:
if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
@@ -12027,10 +12019,6 @@ Perl_ck_each(pTHX_ OP *o)
dVAR;
OP *kid = o->op_flags & OPf_KIDS ? cUNOPo->op_first : NULL;
const unsigned orig_type = o->op_type;
- const unsigned array_type = orig_type == OP_EACH ? OP_AEACH
- : orig_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
- const unsigned ref_type = orig_type == OP_EACH ? OP_REACH
- : orig_type == OP_KEYS ? OP_RKEYS : OP_RVALUES;
PERL_ARGS_ASSERT_CK_EACH;
@@ -12041,7 +12029,9 @@ Perl_ck_each(pTHX_ OP *o)
break;
case OP_PADAV:
case OP_RV2AV:
- OpTYPE_set(o, array_type);
+ OpTYPE_set(o, orig_type == OP_EACH ? OP_AEACH
+ : orig_type == OP_KEYS ? OP_AKEYS
+ : OP_AVALUES);
break;
case OP_CONST:
if (kid->op_private == OPpCONST_BARE
@@ -12052,17 +12042,12 @@ Perl_ck_each(pTHX_ OP *o)
/* we let ck_fun handle it */
break;
default:
- OpTYPE_set(o, ref_type);
- scalar(kid);
+ Perl_croak_nocontext(
+ "Experimental %s on scalar is now forbidden",
+ PL_op_desc[orig_type]);
+ break;
}
}
- /* if treating as a reference, defer additional checks to runtime */
- if (o->op_type == ref_type) {
- /* diag_listed_as: keys on reference is experimental */
- Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__AUTODEREF),
- "%s is experimental", PL_op_desc[ref_type]);
- return o;
- }
return ck_fun(o);
}
@@ -14185,16 +14170,16 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name,
const int code,
case KEY_x : case KEY_xor :
if (!opnum) return NULL; nullret = TRUE; goto findopnum;
case KEY_glob: retsetpvs("_;", OP_GLOB);
- case KEY_keys: retsetpvs("+", OP_KEYS);
- case KEY_values: retsetpvs("+", OP_VALUES);
- case KEY_each: retsetpvs("+", OP_EACH);
- case KEY_push: retsetpvs("+@", OP_PUSH);
- case KEY_unshift: retsetpvs("+@", OP_UNSHIFT);
- case KEY_pop: retsetpvs(";+", OP_POP);
- case KEY_shift: retsetpvs(";+", OP_SHIFT);
+ case KEY_keys: retsetpvs("\\[%@]", OP_KEYS);
+ case KEY_values: retsetpvs("\\[%@]", OP_VALUES);
+ case KEY_each: retsetpvs("\\[%@]", OP_EACH);
+ case KEY_push: retsetpvs("\\@@", OP_PUSH);
+ case KEY_unshift: retsetpvs("\\@@", OP_UNSHIFT);
+ case KEY_pop: retsetpvs(";\\@", OP_POP);
+ case KEY_shift: retsetpvs(";\\@", OP_SHIFT);
case KEY_pos: retsetpvs(";\\[$*]", OP_POS);
case KEY_splice:
- retsetpvs("+;$$@", OP_SPLICE);
+ retsetpvs("\\@;$$@", OP_SPLICE);
case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
retsetpvs("", 0);
case KEY_evalbytes:
diff --git a/opcode.h b/opcode.h
index 5c4254b..d314035 100644
--- a/opcode.h
+++ b/opcode.h
@@ -142,8 +142,6 @@
#define Perl_pp_sgrent Perl_pp_ehostent
#define Perl_pp_egrent Perl_pp_ehostent
#define Perl_pp_custom Perl_unimplemented_op
-#define Perl_pp_reach Perl_pp_rkeys
-#define Perl_pp_rvalues Perl_pp_rkeys
START_EXTERN_C
#ifndef DOINIT
@@ -531,9 +529,6 @@ EXTCONST char* const PL_op_name[] = {
"lock",
"once",
"custom",
- "reach",
- "rkeys",
- "rvalues",
"coreargs",
"runcv",
"fc",
@@ -935,9 +930,6 @@ EXTCONST char* const PL_op_desc[] = {
"lock",
"once",
"unknown custom operator",
- "each on reference",
- "keys on reference",
- "values on reference",
"CORE:: subroutine",
"__SUB__",
"fc",
@@ -1353,9 +1345,6 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
Perl_pp_lock,
Perl_pp_once,
Perl_pp_custom, /* implemented by Perl_unimplemented_op */
- Perl_pp_reach, /* implemented by Perl_pp_rkeys */
- Perl_pp_rkeys,
- Perl_pp_rvalues, /* implemented by Perl_pp_rkeys */
Perl_pp_coreargs,
Perl_pp_runcv,
Perl_pp_fc,
@@ -1767,9 +1756,6 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
Perl_ck_rfun, /* lock */
Perl_ck_null, /* once */
Perl_ck_null, /* custom */
- Perl_ck_each, /* reach */
- Perl_ck_each, /* rkeys */
- Perl_ck_each, /* rvalues */
Perl_ck_null, /* coreargs */
Perl_ck_null, /* runcv */
Perl_ck_fun, /* fc */
@@ -2175,9 +2161,6 @@ EXTCONST U32 PL_opargs[] = {
0x00007b04, /* lock */
0x00000300, /* once */
0x00000000, /* custom */
- 0x00001b40, /* reach */
- 0x00001b08, /* rkeys */
- 0x00001b48, /* rvalues */
0x00000600, /* coreargs */
0x00000004, /* runcv */
0x00009b8e, /* fc */
@@ -2813,9 +2796,6 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* lock */
0, /* once */
-1, /* custom */
- 0, /* reach */
- 40, /* rkeys */
- 0, /* rvalues */
183, /* coreargs */
3, /* runcv */
0, /* fc */
@@ -2846,7 +2826,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
*/
EXTCONST U16 PL_op_private_bitdefs[] = {
- 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe,
regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc,
predec, i_predec, postinc, i_postinc, postdec, i ... [602 chars truncated]
+ 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe,
regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc,
predec, i_predec, postinc, i_postinc, postdec, i ... [586 chars truncated]
0x29dc, 0x3bd9, /* pushmark */
0x00bd, /* wantarray, runcv */
0x03b8, 0x1570, 0x3c8c, 0x3748, 0x2da5, /* const */
@@ -2859,7 +2839,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x3698, 0x3ef1, /* pushre, match, qr, subst */
0x29dc, 0x1758, 0x0256, 0x2acc, 0x2cc8, 0x3c84, 0x0003, /* rv2gv */
0x29dc, 0x2ef8, 0x0256, 0x3c84, 0x0003, /* rv2sv */
- 0x2acc, 0x0003, /* av2arylen, pos, keys, rkeys */
+ 0x2acc, 0x0003, /* av2arylen, pos, keys */
0x2c3c, 0x0b98, 0x08f4, 0x028c, 0x3e48, 0x3c84, 0x0003, /* rv2cv */
0x012f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist,
anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask,
binmode, tie, dbmopen, sselect, select, getc, rea ... [363 chars truncated]
0x30dc, 0x2ff8, 0x24b4, 0x23f0, 0x0003, /* backtick */
@@ -3298,9 +3278,6 @@ EXTCONST U8 PL_op_private_valid[] = {
/* LOCK */ (OPpARG1_MASK),
/* ONCE */ (OPpARG1_MASK),
/* CUSTOM */ (0xff),
- /* REACH */ (OPpARG1_MASK),
- /* RKEYS */ (OPpARG1_MASK|OPpMAYBE_LVSUB),
- /* RVALUES */ (OPpARG1_MASK),
/* COREARGS */
(OPpCOREARGS_DEREF1|OPpCOREARGS_DEREF2|OPpCOREARGS_SCALARMOD|OPpCOREARGS_PUSHMARK),
/* RUNCV */ (OPpOFFBYONE),
/* FC */ (OPpARG1_MASK),
diff --git a/opnames.h b/opnames.h
index c225ac4..065c1a8 100644
--- a/opnames.h
+++ b/opnames.h
@@ -395,25 +395,22 @@ typedef enum opcode {
OP_LOCK = 378,
OP_ONCE = 379,
OP_CUSTOM = 380,
- OP_REACH = 381,
- OP_RKEYS = 382,
- OP_RVALUES = 383,
- OP_COREARGS = 384,
- OP_RUNCV = 385,
- OP_FC = 386,
- OP_PADCV = 387,
- OP_INTROCV = 388,
- OP_CLONECV = 389,
- OP_PADRANGE = 390,
- OP_REFASSIGN = 391,
- OP_LVREF = 392,
- OP_LVREFSLICE = 393,
- OP_LVAVREF = 394,
- OP_ANONCONST = 395,
+ OP_COREARGS = 381,
+ OP_RUNCV = 382,
+ OP_FC = 383,
+ OP_PADCV = 384,
+ OP_INTROCV = 385,
+ OP_CLONECV = 386,
+ OP_PADRANGE = 387,
+ OP_REFASSIGN = 388,
+ OP_LVREF = 389,
+ OP_LVREFSLICE = 390,
+ OP_LVAVREF = 391,
+ OP_ANONCONST = 392,
OP_max
} opcode;
-#define MAXO 396
+#define MAXO 393
#define OP_FREED MAXO
/* the OP_IS_* macros are optimized to a simple range check because
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index ae26fbb..b3114a9 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -77,6 +77,14 @@ XXX For a release on a stable branch, this section aspires
to be:
[ List each incompatible change as a =head2 entry ]
+=head2 The C<autoderef> feature has been removed
+
+The experimental C<autoderef> feature (which allowed calling C<push>,
+C<pop>, C<shift>, C<unshift>, C<splice>, C<keys>, C<values>, and C<each> on
+a scalar argument) has been deemed unsuccessful. It has now been removed;
+trying to use the feature (or to disable the C<experimental::autoderef>
+warning it previously triggered) now yields an exception.
+
=head1 Deprecations
XXX Any deprecated features, syntax, modules etc. should be listed here.
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 159b9ac..71bf1ec 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1959,14 +1959,6 @@ already been freed.
(W unpack) You have applied the same modifier more than once after a
type in a pack template. See L<perlfunc/pack>.
-=item each on reference is experimental
-
-(S experimental::autoderef) C<each> with a scalar argument is experimental
-and may change or be removed in a future Perl version. If you want to
-take the risk of using this feature, simply disable this warning:
-
- no warnings "experimental::autoderef";
-
=item elseif should be elsif
(S syntax) There is no keyword "elseif" in Perl because Larry thinks
@@ -2123,6 +2115,13 @@ L<perlrecharclass/Extended Bracketed Character Classes>.
use feature "signatures";
sub foo ($left, $right) { ... }
+=item Experimental %s on scalar is now forbidden
+
+(F) An experimental feature added in Perl 5.14 allowed C<each>, C<keys>,
+C<push>, C<pop>, C<shift>, C<splice>, C<unshift>, and C<values> to be called
+with a scalar argument. This experiment is considered unsuccessful, and has
+been removed. The C<postderef> feature may meet your needs better.
+
=item Experimental "%s" subs not enabled
(F) To use lexical subs, you must first enable them:
@@ -2961,14 +2960,6 @@ line. See L<perlrun> for more details.
(P) The regular expression parser is confused.
-=item keys on reference is experimental
-
-(S experimental::autoderef) C<keys> with a scalar argument is experimental
-and may change or be removed in a future Perl version. If you want to
-take the risk of using this feature, simply disable this warning:
-
- no warnings "experimental::autoderef";
-
=item Label not found for "last %s"
(F) You named a loop to break out of, but you're not currently in a loop
@@ -4594,14 +4585,6 @@ fine from VMS' perspective, it's probably not what you
intended.
(F) The unpack format P must have an explicit size, not "*".
-=item pop on reference is experimental
-
-(S experimental::autoderef) C<pop> with a scalar argument is experimental
-and may change or be removed in a future Perl version. If you want to
-take the risk of using this feature, simply disable this warning:
-
- no warnings "experimental::autoderef";
-
=item POSIX class [:%s:] unknown in regex; marked by S<<-- HERE> in m/%s/
(F) The class in the character class [: :] syntax is unknown. The S<<-- HERE>
@@ -4821,14 +4804,6 @@ the sub name and via the prototype attribute. The
prototype in
parentheses is useless, since it will be replaced by the prototype
from the attribute before it's ever used.
-=item push on reference is experimental
-
-(S experimental::autoderef) C<push> with a scalar argument is experimental
-and may change or be removed in a future Perl version. If you want to
-take the risk of using this feature, simply disable this warning:
-
- no warnings "experimental::autoderef";
-
=item Quantifier follows nothing in regex; marked by S<<-- HERE> in m/%s/
(F) You started a regular expression with a quantifier. Backslash it if
@@ -5353,14 +5328,6 @@ a positive integer, where the integer was the address of
the reference.
As of Perl 5.20.0 this is a fatal error, to allow future versions of Perl
to use non-integer refs for more interesting purposes.
-=item shift on reference is experimental
-
-(S experimental::autoderef) C<shift> with a scalar argument is experimental
-and may change or be removed in a future Perl version. If you want to
-take the risk of using this feature, simply disable this warning:
-
- no warnings "experimental::autoderef";
-
=item shm%s not implemented
(F) You don't have System V shared memory IPC on your system.
@@ -5441,15 +5408,6 @@ end of the array, rather than past it. If this isn't
what you want,
try explicitly pre-extending the array by assigning $#array = $offset.
See L<perlfunc/splice>.
-=item splice on reference is experimental
-
-(S experimental::autoderef) C<splice> with a scalar argument
-is experimental and may change or be removed in a future
-Perl version. If you want to take the risk of using this
-feature, simply disable this warning:
-
- no warnings "experimental::autoderef";
-
=item Split loop
(P) The split was looping infinitely. (Obviously, a split shouldn't
@@ -5967,11 +5925,6 @@ certain type. Arrays must be @NAME or C<@{EXPR}>.
Hashes must be
%NAME or C<%{EXPR}>. No implicit dereferencing is allowed--use the
{EXPR} forms as an explicit dereference. See L<perlref>.
-=item Type of argument to %s must be unblessed hashref or arrayref
-
-(F) You called C<keys>, C<values> or C<each> with a scalar argument that
-was not a reference to an unblessed hash or array.
-
=item umask not implemented
(F) Your machine doesn't implement the umask function and you tried to
@@ -6347,15 +6300,6 @@ on your system.
think you didn't do that, check the #! line to see if it's supplying the
bad switch on your behalf.)
-=item unshift on reference is experimental
-
-(S experimental::autoderef) C<unshift> with a scalar argument
-is experimental and may change or be removed in a future
-Perl version. If you want to take the risk of using this
-feature, simply disable this warning:
-
- no warnings "experimental::autoderef";
-
=item Unsuccessful %s on filename containing newline
(W newline) A file operation was attempted on a filename, and that
@@ -6895,15 +6839,6 @@ C<defined> operator.
longer than 1024 characters. The return value has been truncated to
1024 characters.
-=item values on reference is experimental
-
-(S experimental::autoderef) C<values> with a scalar argument
-is experimental and may change or be removed in a future
-Perl version. If you want to take the risk of using this
-feature, simply disable this warning:
-
- no warnings "experimental::autoderef";
-
=item Variable "%s" is not available
(W closure) During compilation, an inner named subroutine or eval is
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index a3f612d..17180ca 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -1651,8 +1651,6 @@ X<each> X<hash, iterator>
=item each ARRAY
X<array, iterator>
-=item each EXPR
-
=for Pod::Functions retrieve the next key/value pair from a hash
When called on a hash in list context, returns a 2-element list
@@ -1701,12 +1699,9 @@ but in a different order:
print "$key=$value\n";
}
-Starting with Perl 5.14, C<each> can take a scalar EXPR, which must hold a
-reference to an unblessed hash or array. The argument will be dereferenced
-automatically. This aspect of C<each> is considered highly experimental.
-The exact behaviour may change in a future version of Perl.
-
- while (($key,$value) = each $hashref) { ... }
+Starting with Perl 5.14, an experimental feature allowed C<each> to take a
+scalar expression. This experiment has been deemed unsuccessful, and was
+removed as of Perl 5.24.
As of Perl 5.18 you can use a bare C<each> in a C<while> loop,
which will set C<$_> on every iteration.
@@ -1721,7 +1716,6 @@ the top of your file to signal that your code will work
I<only> on Perls of
a recent vintage:
use 5.012; # so keys/values/each work on arrays
- use 5.014; # so keys/values/each work on scalars (experimental)
use 5.018; # so each assigns to $_ in a lone while test
See also C<keys>, C<values>, and C<sort>.
@@ -3156,8 +3150,6 @@ X<keys> X<key>
=item keys ARRAY
-=item keys EXPR
-
=for Pod::Functions retrieve list of indices from a hash
Called in list context, returns a list consisting of all the keys of the
@@ -3223,13 +3215,9 @@ C<keys> in this way (but you needn't worry about doing
this by accident,
as trying has no effect). C<keys @array> in an lvalue context is a syntax
error.
-Starting with Perl 5.14, C<keys> can take a scalar EXPR, which must contain
-a reference to an unblessed hash or array. The argument will be
-dereferenced automatically. This aspect of C<keys> is considered highly
-experimental. The exact behaviour may change in a future version of Perl.
-
- for (keys $hashref) { ... }
- for (keys $obj->get_arrayref) { ... }
+Starting with Perl 5.14, an experimental feature allowed C<keys> to take a
+scalar expression. This experiment has been deemed unsuccessful, and was
+removed as of Perl 5.24.
To avoid confusing would-be users of your code who are running earlier
versions of Perl with mysterious syntax errors, put this sort of thing at
@@ -3237,7 +3225,6 @@ the top of your file to signal that your code will work
I<only> on Perls of
a recent vintage:
use 5.012; # so keys/values/each work on arrays
- use 5.014; # so keys/values/each work on scalars (experimental)
See also C<each>, C<values>, and C<sort>.
@@ -5218,8 +5205,6 @@ the current value of $^F (by default 2 for C<STDERR>).
See L<perlvar/$^F>.
=item pop ARRAY
X<pop> X<stack>
-=item pop EXPR
-
=item pop
=for Pod::Functions remove the last element from an array and return it
@@ -5231,17 +5216,9 @@ Returns the undefined value if the array is empty,
although this may also
happen at other times. If ARRAY is omitted, pops the C<@ARGV> array in the
main program, but the C<@_> array in subroutines, just like C<shift>.
-Starting with Perl 5.14, C<pop> can take a scalar EXPR, which must hold a
-reference to an unblessed array. The argument will be dereferenced
-automatically. This aspect of C<pop> is considered highly experimental.
-The exact behaviour may change in a future version of Perl.
-
-To avoid confusing would-be users of your code who are running earlier
-versions of Perl with mysterious syntax errors, put this sort of thing at
-the top of your file to signal that your code will work I<only> on Perls of
-a recent vintage:
-
- use 5.014; # so push/pop/etc work on scalars (experimental)
+Starting with Perl 5.14, an experimental feature allowed C<pop> to take a
+scalar expression. This experiment has been deemed unsuccessful, and was
+removed as of Perl 5.24.
=item pos SCALAR
X<pos> X<match, position>
@@ -5371,8 +5348,6 @@ describing the equivalent prototype is returned.
=item push ARRAY,LIST
X<push> X<stack>
-=item push EXPR,LIST
-
=for Pod::Functions append one or more elements to an array
Treats ARRAY as a stack by appending the values of LIST to the end of
@@ -5386,17 +5361,9 @@ effect as
but is more efficient. Returns the number of elements in the array following
the completed C<push>.
-Starting with Perl 5.14, C<push> can take a scalar EXPR, which must hold a
-reference to an unblessed array. The argument will be dereferenced
-automatically. This aspect of C<push> is considered highly experimental.
-The exact behaviour may change in a future version of Perl.
-
-To avoid confusing would-be users of your code who are running earlier
-versions of Perl with mysterious syntax errors, put this sort of thing at
-the top of your file to signal that your code will work I<only> on Perls of
-a recent vintage:
-
- use 5.014; # so push/pop/etc work on scalars (experimental)
+Starting with Perl 5.14, an experimental feature allowed C<push> to take a
+scalar expression. This experiment has been deemed unsuccessful, and was
+removed as of Perl 5.24.
=item q/STRING/
@@ -6513,8 +6480,6 @@ Portability issues: L<perlport/setsockopt>.
=item shift ARRAY
X<shift>
-=item shift EXPR
-
=item shift
=for Pod::Functions remove the first element of an array, and return it
@@ -6527,17 +6492,9 @@ C<@ARGV> array outside a subroutine and also within the
lexical scopes
established by the C<eval STRING>, C<BEGIN {}>, C<INIT {}>, C<CHECK {}>,
C<UNITCHECK {}>, and C<END {}> constructs.
-Starting with Perl 5.14, C<shift> can take a scalar EXPR, which must hold a
-reference to an unblessed array. The argument will be dereferenced
-automatically. This aspect of C<shift> is considered highly experimental.
-The exact behaviour may change in a future version of Perl.
-
-To avoid confusing would-be users of your code who are running earlier
-versions of Perl with mysterious syntax errors, put this sort of thing at
-the top of your file to signal that your code will work I<only> on Perls of
-a recent vintage:
-
- use 5.014; # so push/pop/etc work on scalars (experimental)
+Starting with Perl 5.14, an experimental feature allowed C<shift> to take a
+scalar expression. This experiment has been deemed unsuccessful, and was
+removed as of Perl 5.24.
See also C<unshift>, C<push>, and C<pop>. C<shift> and C<unshift> do the
same thing to the left end of an array that C<pop> and C<push> do to the
@@ -6910,14 +6867,6 @@ X<splice>
=item splice ARRAY
-=item splice EXPR,OFFSET,LENGTH,LIST
-
-=item splice EXPR,OFFSET,LENGTH
-
-=item splice EXPR,OFFSET
-
-=item splice EXPR
-
=for Pod::Functions add or remove elements anywhere in an array
Removes the elements designated by OFFSET and LENGTH from an array, and
@@ -6956,17 +6905,9 @@ C<splice> can be used, for example, to implement n-ary
queue processing:
# d -- e -- f
# g -- h
-Starting with Perl 5.14, C<splice> can take scalar EXPR, which must hold a
-reference to an unblessed array. The argument will be dereferenced
-automatically. This aspect of C<splice> is considered highly experimental.
-The exact behaviour may change in a future version of Perl.
-
-To avoid confusing would-be users of your code who are running earlier
-versions of Perl with mysterious syntax errors, put this sort of thing at
-the top of your file to signal that your code will work I<only> on Perls of
-a recent vintage:
-
- use 5.014; # so push/pop/etc work on scalars (experimental)
+Starting with Perl 5.14, an experimental feature allowed C<splice> to take a
+scalar expression. This experiment has been deemed unsuccessful, and was
+removed as of Perl 5.24.
=item split /PATTERN/,EXPR,LIMIT
X<split>
@@ -8598,8 +8539,6 @@ See L</pack> for more examples and notes.
=item unshift ARRAY,LIST
X<unshift>
-=item unshift EXPR,LIST
-
=for Pod::Functions prepend more elements to the beginning of a list
Does the opposite of a C<shift>. Or the opposite of a C<push>,
@@ -8612,17 +8551,9 @@ Note the LIST is prepended whole, not one element at a
time, so the
prepended elements stay in the same order. Use C<reverse> to do the
reverse.
-Starting with Perl 5.14, C<unshift> can take a scalar EXPR, which must hold
-a reference to an unblessed array. The argument will be dereferenced
-automatically. This aspect of C<unshift> is considered highly
-experimental. The exact behaviour may change in a future version of Perl.
-
-To avoid confusing would-be users of your code who are running earlier
-versions of Perl with mysterious syntax errors, put this sort of thing at
-the top of your file to signal that your code will work I<only> on Perls of
-a recent vintage:
-
- use 5.014; # so push/pop/etc work on scalars (experimental)
+Starting with Perl 5.14, an experimental feature allowed C<unshift> to take
+a scalar expression. This experiment has been deemed unsuccessful, and was
+removed as of Perl 5.24.
=item untie VARIABLE
X<untie>
@@ -8817,8 +8748,6 @@ X<values>
=item values ARRAY
-=item values EXPR
-
=for Pod::Functions return a list of the values in a hash
In list context, returns a list consisting of all the values of the named
@@ -8854,13 +8783,9 @@ modify the contents of the hash:
for (values %hash) { s/foo/bar/g } # modifies %hash values
for (@hash{keys %hash}) { s/foo/bar/g } # same
-Starting with Perl 5.14, C<values> can take a scalar EXPR, which must hold
-a reference to an unblessed hash or array. The argument will be
-dereferenced automatically. This aspect of C<values> is considered highly
-experimental. The exact behaviour may change in a future version of Perl.
-
- for (values $hashref) { ... }
- for (values $obj->get_arrayref) { ... }
+Starting with Perl 5.14, an experimental feature allowed C<values> to take a
+scalar expression. This experiment has been deemed unsuccessful, and was
+removed as of Perl 5.24.
To avoid confusing would-be users of your code who are running earlier
versions of Perl with mysterious syntax errors, put this sort of thing at
@@ -8868,7 +8793,6 @@ the top of your file to signal that your code will work
I<only> on Perls of
a recent vintage:
use 5.012; # so keys/values/each work on arrays
- use 5.014; # so keys/values/each work on scalars (experimental)
See also C<keys>, C<each>, and C<sort>.
diff --git a/pod/perlsub.pod b/pod/perlsub.pod
index 48f178f..de2cc10 100644
--- a/pod/perlsub.pod
+++ b/pod/perlsub.pod
@@ -1394,8 +1394,8 @@ using function prototyping. This can be declared in
either the PROTO
section or with a L<prototype attribute|attributes/Built-in Attributes>.
If you declare either of
- sub mypush (+@)
- sub mypush :prototype(+@)
+ sub mypush (\@@)
+ sub mypush :prototype(\@@)
then C<mypush()> takes arguments exactly like C<push()> does.
@@ -1432,9 +1432,9 @@ corresponding built-in.
sub mysyswrite ($$$;$) mysyswrite $buf, 0, length($buf) - $off, $off
sub myreverse (@) myreverse $a, $b, $c
sub myjoin ($@) myjoin ":", $a, $b, $c
- sub mypop (+) mypop @array
- sub mysplice (+$$@) mysplice @array, 0, 2, @pushme
- sub mykeys (+) mykeys %{$hashref}
+ sub mypop (\@) mypop @array
+ sub mysplice (\@$$@) mysplice @array, 0, 2, @pushme
+ sub mykeys (\[%@]) mykeys %{$hashref}
sub myopen (*;$) myopen HANDLE, $name
sub mypipe (**) mypipe READHANDLE, WRITEHANDLE
sub mygrep (&@) mygrep { /foo/ } $a, $b, $c
diff --git a/pp.c b/pp.c
index 4542868..f750fce 100644
--- a/pp.c
+++ b/pp.c
@@ -4664,47 +4664,6 @@ PP(pp_kvaslice)
}
-/* Smart dereferencing for keys, values and each */
-
-/* also used for: pp_reach() pp_rvalues() */
-
-PP(pp_rkeys)
-{
- dSP;
- dPOPss;
-
- SvGETMAGIC(sv);
-
- if (
- !SvROK(sv)
- || (sv = SvRV(sv),
- (SvTYPE(sv) != SVt_PVHV && SvTYPE(sv) != SVt_PVAV)
- || SvOBJECT(sv)
- )
- ) {
- DIE(aTHX_
- "Type of argument to %s must be unblessed hashref or arrayref",
- PL_op_desc[PL_op->op_type] );
- }
-
- if (PL_op->op_flags & OPf_SPECIAL && SvTYPE(sv) == SVt_PVAV)
- DIE(aTHX_
- "Can't modify %s in %s",
- PL_op_desc[PL_op->op_type], PL_op_desc[PL_op->op_next->op_type]
- );
-
- /* Delegate to correct function for op type */
- PUSHs(sv);
- if (PL_op->op_type == OP_RKEYS || PL_op->op_type == OP_RVALUES) {
- return (SvTYPE(sv) == SVt_PVHV) ? Perl_do_kv(aTHX) :
Perl_pp_akeys(aTHX);
- }
- else {
- return (SvTYPE(sv) == SVt_PVHV)
- ? Perl_pp_each(aTHX)
- : Perl_pp_aeach(aTHX);
- }
-}
-
PP(pp_aeach)
{
dSP;
@@ -4749,7 +4708,7 @@ PP(pp_akeys)
EXTEND(SP, n + 1);
- if (PL_op->op_type == OP_AKEYS || PL_op->op_type == OP_RKEYS) {
+ if (PL_op->op_type == OP_AKEYS) {
for (i = 0; i <= n; i++) {
mPUSHi(i);
}
diff --git a/pp_proto.h b/pp_proto.h
index 7f9d122..96934ff 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -215,7 +215,6 @@ PERL_CALLCONV OP *Perl_pp_return(pTHX);
PERL_CALLCONV OP *Perl_pp_reverse(pTHX);
PERL_CALLCONV OP *Perl_pp_rewinddir(pTHX);
PERL_CALLCONV OP *Perl_pp_right_shift(pTHX);
-PERL_CALLCONV OP *Perl_pp_rkeys(pTHX);
PERL_CALLCONV OP *Perl_pp_rmdir(pTHX);
PERL_CALLCONV OP *Perl_pp_runcv(pTHX);
PERL_CALLCONV OP *Perl_pp_rv2av(pTHX);
diff --git a/regcharclass.h b/regcharclass.h
index c3e26c3..c59ea78 100644
--- a/regcharclass.h
+++ b/regcharclass.h
@@ -2517,6 +2517,6 @@
* c9326eab8d7861c3543963e555d5b927348f4467c93071db23154dece7619654
lib/unicore/mktables
* 462c9aaa608fb2014cd9649af1c5c009485c60b9c8b15b89401fdc10cf6161c6
lib/unicore/version
* c6884f4d629f04d1316f3476cb1050b6a1b98ca30c903262955d4eae337c6b1e
regen/charset_translations.pl
- * 1c951614c1cf87c2a801c615a65470d8f5e9388b62690e7498c7661eb7782a01
regen/regcharclass.pl
+ * 5e47f645eac3a918246254e19c06b604c8ea088cf62da5be84dcb953ef2bf16c
regen/regcharclass.pl
* 206b60035ff0cec9f7d1701937ecf9226a943faa42dfc4827c37306be64ff18e
regen/regcharclass_multi_char_folds.pl
* ex: set ro: */
diff --git a/regen/op_private b/regen/op_private
index 06ebca6..bcc1c21 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -440,7 +440,7 @@ addbits($_, 6 => qw(OPpOUR_INTRO OURINTR)) # Variable was
in an our()
# We might be an lvalue to return
addbits($_, 3 => qw(OPpMAYBE_LVSUB LVSUB))
for qw(aassign rv2av rv2gv rv2hv padav padhv aelem helem aslice hslice
- av2arylen keys rkeys kvaslice kvhslice substr pos vec multideref);
+ av2arylen keys kvaslice kvhslice substr pos vec multideref);
diff --git a/regen/opcode.pl b/regen/opcode.pl
index fe10584..50029bd 100755
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -126,7 +126,6 @@ my @raw_alias = (
Perl_pp_sbit_or => ['sbit_xor'],
Perl_pp_rv2av => ['rv2hv'],
Perl_pp_akeys => ['avalues'],
- Perl_pp_rkeys => [qw(rvalues reach)],
Perl_pp_trans => [qw(trans transr)],
Perl_pp_chop => [qw(chop chomp)],
Perl_pp_schop => [qw(schop schomp)],
diff --git a/regen/opcodes b/regen/opcodes
index 8d07eed..9ea0753 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -554,11 +554,6 @@ once once ck_null
|
custom unknown custom operator ck_null 0
-# For smart dereference for each/keys/values
-reach each on reference ck_each d% S
-rkeys keys on reference ck_each t%
S
-rvalues values on reference ck_each dt% S
-
# For CORE:: subs
coreargs CORE:: subroutine ck_null $
diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl
index 9b989df..184437e 100755
--- a/regen/regcharclass.pl
+++ b/regen/regcharclass.pl
@@ -4,7 +4,6 @@ use strict;
use 5.008;
use warnings;
use warnings FATAL => 'all';
-no warnings 'experimental::autoderef';
use Data::Dumper;
$Data::Dumper::Useqq= 1;
our $hex_fmt= "0x%02X";
@@ -873,7 +872,7 @@ sub calculate_mask(@) {
my @final_results;
foreach my $count (reverse sort { $a <=> $b } keys %hash) {
my $need = 2 ** $count; # Need 8 values for 3 differing bits, etc
- foreach my $bits (sort keys $hash{$count}) {
+ foreach my $bits (sort keys $hash{$count}->%*) {
print STDERR __LINE__, ": For $count bit(s) difference ($bits),
need $need; have ", scalar @{$hash{$count}{$bits}}, "\n" if DEBUG;
@@ -961,7 +960,7 @@ sub calculate_mask(@) {
# individually.
my @individuals;
foreach my $count (reverse sort { $a <=> $b } keys %hash) {
- foreach my $bits (sort keys $hash{$count}) {
+ foreach my $bits (sort keys $hash{$count}->%*) {
foreach my $remaining (@{$hash{$count}{$bits}}) {
# If we already know about this value, just ignore it.
diff --git a/regen/warnings.pl b/regen/warnings.pl
index be33087..c4cc19c 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -95,8 +95,6 @@ my $tree = {
[ 5.017, DEFAULT_ON ],
'experimental::postderef' =>
[ 5.019, DEFAULT_ON ],
- 'experimental::autoderef' =>
- [ 5.019, DEFAULT_ON ],
'experimental::signatures' =>
[ 5.019, DEFAULT_ON ],
'experimental::win32_perlio' =>
@@ -483,7 +481,7 @@ read_only_bottom_close_and_rename($pm);
__END__
package warnings;
-our $VERSION = '1.32';
+our $VERSION = '1.33';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
diff --git a/t/lib/croak/op b/t/lib/croak/op
index 2d2887d..cd3a654 100644
--- a/t/lib/croak/op
+++ b/t/lib/croak/op
@@ -111,31 +111,27 @@ EXPECT
exists argument is not a subroutine name at - line 1.
########
# NAME push BAREWORD
-no warnings 'experimental';
push FRED;
EXPECT
-Type of arg 1 to push must be array (not constant item) at - line 2, near
"FRED;"
+Type of arg 1 to push must be array (not constant item) at - line 1, near
"FRED;"
Execution of - aborted due to compilation errors.
########
# NAME pop BAREWORD
-no warnings 'experimental';
pop FRED;
EXPECT
-Type of arg 1 to pop must be array (not constant item) at - line 2, near
"FRED;"
+Type of arg 1 to pop must be array (not constant item) at - line 1, near
"FRED;"
Execution of - aborted due to compilation errors.
########
# NAME shift BAREWORD
-no warnings 'experimental';
shift FRED;
EXPECT
-Type of arg 1 to shift must be array (not constant item) at - line 2, near
"FRED;"
+Type of arg 1 to shift must be array (not constant item) at - line 1, near
"FRED;"
Execution of - aborted due to compilation errors.
########
# NAME unshift BAREWORD
-no warnings 'experimental';
unshift FRED;
EXPECT
-Type of arg 1 to unshift must be array (not constant item) at - line 2, near
"FRED;"
+Type of arg 1 to unshift must be array (not constant item) at - line 1, near
"FRED;"
Execution of - aborted due to compilation errors.
########
# NAME keys BAREWORD
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 477fdad..d2f8e57 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -61,12 +61,6 @@
format FRED =
.
- push on reference is experimental [ck_fun]
- pop on reference is experimental
- shift on reference is experimental
- unshift on reference is experimental
- splice on reference is experimental
-
Statement unlikely to be reached
(Maybe you meant system() when you said exec()?
exec "true" ; my $a
@@ -82,10 +76,6 @@
$[ used in comparison (did you mean $] ?)
- each on reference is experimental [ck_each]
- keys on reference is experimental
- values on reference is experimental
-
length() used on @array (did you mean "scalar(@array)"?)
length() used on %hash (did you mean "scalar(keys %hash)"?)
@@ -240,12 +230,6 @@ use constant phoo => 1..3;
@h{localtime 0};
@h{gmtime 0};
@h{eval ""};
-{
- no warnings 'experimental::autoderef';
- @h{each $foo} if 0;
- @h{keys $foo} if 0;
- @h{values $foo} if 0;
-}
# arrays
@h[qw"a b c"] = 1..3;
@@ -283,12 +267,6 @@ use constant phoo => 1..3;
@h[localtime 0];
@h[gmtime 0];
@h[eval ""];
-{
- no warnings 'experimental::autoderef';
- @h[each $foo] if 0;
- @h[keys $foo] if 0;
- @h[values $foo] if 0;
-}
EXPECT
########
# op.c
@@ -1053,26 +1031,6 @@ format FRED =
EXPECT
Format FRED redefined at - line 5.
########
-# op.c [Perl_ck_fun]
-$fred = [];
-push $fred;
-pop $fred;
-shift $fred;
-unshift $fred;
-splice $fred;
-no warnings 'experimental::autoderef' ;
-push $fred;
-pop $fred;
-shift $fred;
-unshift $fred;
-splice $fred;
-EXPECT
-push on reference is experimental at - line 3.
-pop on reference is experimental at - line 4.
-shift on reference is experimental at - line 5.
-unshift on reference is experimental at - line 6.
-splice on reference is experimental at - line 7.
-########
# op.c
use warnings 'exec' ;
exec "$^X -e 1" ;
@@ -1394,20 +1352,6 @@ $[ used in numeric gt (>) (did you mean $] ?) at - line
18.
$[ used in numeric le (<=) (did you mean $] ?) at - line 19.
$[ used in numeric ge (>=) (did you mean $] ?) at - line 20.
########
-# op.c [Perl_ck_each]
-$fred = {};
-keys $fred;
-values $fred;
-each $fred;
-no warnings 'experimental::autoderef' ;
-keys $fred;
-values $fred;
-each $fred;
-EXPECT
-keys on reference is experimental at - line 3.
-values on reference is experimental at - line 4.
-each on reference is experimental at - line 5.
-########
# op.c [Perl_ck_length]
use warnings 'syntax' ;
length(@a);
diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 6fec5f4..c18fdcd 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -166,18 +166,6 @@ $tests++;
ok eval { *CORE::exit = \42 },
'[rt.cpan.org #74289] *CORE::foo is not accidentally made read-only';
-for my $word (qw<keys values each>) {
- # mykeys() etc were aliased to \&CORE::keys etc above
- my $code = qq{
- no warnings 'experimental::autoderef';
- my \$x = [];
- () = my$word(\$x);
- 'ok'
- };
- $tests++;
- is(eval($code), 'ok', "inlined $word() on autoderef array") or diag $@;
-}
-
inlinable_ok($_, '$_{k}', 'on hash')
for qw<delete exists>;
diff --git a/t/op/cproto.t b/t/op/cproto.t
index b2f07f7..aace8aa 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -75,7 +75,7 @@ delete undef
die (@)
do undef
dump ()
-each (+)
+each (\[%@])
else undef
elsif undef
endgrent ()
@@ -140,7 +140,7 @@ index ($$;$)
int (_)
ioctl (*$$)
join ($@)
-keys (+)
+keys (\[%@])
kill (@)
last undef
lc (_)
@@ -176,12 +176,12 @@ our undef
pack ($@)
package undef
pipe (**)
-pop (;+)
+pop (;\@)
pos (;\[$*])
print undef
printf undef
prototype (_)
-push (+@)
+push (\@@)
q undef
qq undef
qr undef
@@ -224,7 +224,7 @@ setprotoent ($)
setpwent ()
setservent ($)
setsockopt (*$$$)
-shift (;+)
+shift (;\@)
shmctl ($$$)
shmget ($$$)
shmread ($$$$)
@@ -235,7 +235,7 @@ sleep (;$)
socket (*$$$)
socketpair (**$$$)
sort undef
-splice (+;$$@)
+splice (\@;$$@)
split undef
sprintf ($@)
sqrt (_)
@@ -267,12 +267,12 @@ undef (;\[$@%&*])
unless undef
unlink (@)
unpack ($_)
-unshift (+@)
+unshift (\@@)
untie (\[$@%*])
until undef
use undef
utime (@)
-values (+)
+values (\[%@])
vec ($$$)
wait ()
waitpid ($$)
diff --git a/t/op/kvaslice.t b/t/op/kvaslice.t
index 16ee446..aec9a97 100644
--- a/t/op/kvaslice.t
+++ b/t/op/kvaslice.t
@@ -8,7 +8,7 @@ BEGIN {
# use strict;
-plan tests => 40;
+plan tests => 39;
# simple use cases
{
@@ -178,17 +178,19 @@ plan tests => 40;
ok( !exists $a[3], "no autovivification" );
}
-# keys/value/each treat argument as scalar
+# keys/value/each refuse to compile kvaslice
{
my %h = 'a'..'b';
my @i = \%h;
- no warnings 'syntax', 'experimental::autoderef';
- my ($k,$v) = each %i[0];
- is $k, 'a', 'key returned by each %array[ix]';
- is $v, 'b', 'val returned by each %array[ix]';
- %h = 1..10;
- is join('-', sort keys %i[(0)]), '1-3-5-7-9', 'keys %array[ix]';
- is join('-', sort values %i[(0)]), '10-2-4-6-8', 'values %array[ix]';
+ eval '() = keys %i[(0)]';
+ like($@, qr/Experimental keys on scalar is now forbidden/,
+ 'keys %array[ix] forbidden');
+ eval '() = values %i[(0)]';
+ like($@, qr/Experimental values on scalar is now forbidden/,
+ 'values %array[ix] forbidden');
+ eval '() = each %i[(0)]';
+ like($@, qr/Experimental each on scalar is now forbidden/,
+ 'each %array[ix] forbidden');
}
# \% prototype expects hash deref
diff --git a/t/op/kvhslice.t b/t/op/kvhslice.t
index a5357ad..2bc6334 100644
--- a/t/op/kvhslice.t
+++ b/t/op/kvhslice.t
@@ -8,7 +8,7 @@ BEGIN {
# use strict;
-plan tests => 40;
+plan tests => 39;
# simple use cases
{
@@ -184,17 +184,19 @@ plan tests => 40;
ok( !exists $h{e}, "no autovivification" );
}
-# keys/value/each treat argument as scalar
+# keys/value/each refuse to compile kvhslice
{
my %h = 'a'..'b';
my %i = (foo => \%h);
- no warnings 'syntax', 'experimental::autoderef';
- my ($k,$v) = each %i{foo=>};
- is $k, 'a', 'key returned by each %hash{key}';
- is $v, 'b', 'val returned by each %hash{key}';
- %h = 1..10;
- is join('-', sort keys %i{foo=>}), '1-3-5-7-9', 'keys %hash{key}';
- is join('-', sort values %i{foo=>}), '10-2-4-6-8', 'values %hash{key}';
+ eval '() = keys %i{foo=>}';
+ like($@, qr/Experimental keys on scalar is now forbidden/,
+ 'keys %hash{key} forbidden');
+ eval '() = values %i{foo=>}';
+ like($@, qr/Experimental values on scalar is now forbidden/,
+ 'values %hash{key} forbidden');
+ eval '() = each %i{foo=>}';
+ like($@, qr/Experimental each on scalar is now forbidden/,
+ 'each %hash{key} forbidden');
}
# \% prototype expects hash deref
diff --git a/t/op/push.t b/t/op/push.t
index f4b034f..c94c919 100644
--- a/t/op/push.t
+++ b/t/op/push.t
@@ -20,7 +20,7 @@ BEGIN {
-4, 4 5 6 7, 0 1 2 3
EOF
-plan tests => 14 + @tests*4;
+plan tests => 8 + @tests*2;
die "blech" unless @tests;
@x = (1,2,3);
@@ -29,37 +29,20 @@ is( join(':',@x), '1:2:3:1:2:3', 'push array onto array');
push(@x,4);
is( join(':',@x), '1:2:3:1:2:3:4', 'push integer onto array');
-no warnings 'experimental::autoderef';
-
-# test for push/pop on arrayref
-push(\@x,5);
-is( join(':',@x), '1:2:3:1:2:3:4:5', 'push arrayref');
-pop(\@x);
-is( join(':',@x), '1:2:3:1:2:3:4', 'pop arrayref');
-
# test autovivification
push @$undef1, 1, 2, 3;
is( join(':',@$undef1), '1:2:3', 'autovivify array');
-# test push on undef (error)
-eval { push $undef2, 1, 2, 3 };
-like( $@, qr/Not an ARRAY/, 'push on undef generates an error');
-
-# test constant
-use constant CONST_ARRAYREF => [qw/a b c/];
-push CONST_ARRAYREF(), qw/d e f/;
-is( join(':',@{CONST_ARRAYREF()}), 'a:b:c:d:e:f', 'test constant');
-
# test implicit dereference errors
eval "push 42, 0, 1, 2, 3";
like ( $@, qr/must be array/, 'push onto a literal integer');
$hashref = { };
-eval { push $hashref, 0, 1, 2, 3 };
-like( $@, qr/Not an ARRAY reference/, 'push onto a hashref');
+eval q{ push $hashref, 0, 1, 2, 3 };
+like( $@, qr/Experimental push on scalar is now forbidden/, 'push onto a
hashref');
-eval { push bless([]), 0, 1, 2, 3 };
-like( $@, qr/Not an unblessed ARRAY reference/, 'push onto a blessed array
ref');
+eval q{ push bless([]), 0, 1, 2, 3 };
+like( $@, qr/Experimental push on scalar is now forbidden/, 'push onto a
blessed array ref');
$test = 13;
@@ -67,13 +50,9 @@ $test = 13;
{
my($first, $second) = ([1], [2]);
sub two_things { return +($first, $second) }
- push two_things(), 3;
+ push @{ two_things() }, 3;
is( join(':',@$first), '1', "\$first = [ @$first ];");
is( join(':',@$second), '2:3', "\$second = [ @$second ]");
-
- push @{ two_things() }, 4;
- is( join(':',@$first), '1', "\$first = [ @$first ];");
- is( join(':',@$second), '2:3:4', "\$second = [ @$second ]");
}
foreach $line (@tests) {
@@ -82,19 +61,14 @@ foreach $line (@tests) {
@get = split(' ',$get);
@leave = split(' ',$leave);
@x = (0,1,2,3,4,5,6,7);
- $y = [0,1,2,3,4,5,6,7];
if (defined $len) {
@got = splice(@x, $pos, $len, @list);
- @got2 = splice($y, $pos, $len, @list);
}
else {
@got = splice(@x, $pos);
- @got2 = splice($y, $pos);
}
is(join(':',@got), join(':',@get), "got: @got == @get");
is(join(':',@x), join(':',@leave), "left: @x == @leave");
- is(join(':',@got2), join(':',@get), "ref got: @got2 == @get");
- is(join(':',@$y), join(':',@leave), "ref left: @$y == @leave");
}
1; # this file is require'd by lib/tie-stdpush.t
diff --git a/t/op/smartkve.t b/t/op/smartkve.t
index 1b54adc..d93dde1 100644
--- a/t/op/smartkve.t
+++ b/t/op/smartkve.t
@@ -7,463 +7,119 @@ BEGIN {
}
use strict;
use warnings;
-no warnings 'experimental::autoderef', 'experimental::refaliasing';
+no warnings 'experimental::refaliasing';
use vars qw($data $array $values $hash $errpat);
plan 'no_plan';
-sub j { join(":",@_) }
-
-# NOTE
-#
-# Hash insertion is currently unstable, in that
-# %hash= %otherhash will not necessarily result in
-# the same internal ordering of the data in the hash.
-# For instance when keys collide the copy may not
-# match the inserted order. So we declare one hash
-# and then make all our copies from that, which should
-# mean all the copies have the same internal structure.
-#
-# And these days, even if all that weren't true, we now
-# per-hash randomize keys/values. So, we cant expect two
-# hashes with the same internal structure to return the
-# same thing at all. All we *can* expect is that keys()
-# and values() use the same ordering.
-our %base_hash;
-
-BEGIN { # in BEGIN for "use constant ..." later
- # values match keys here so we can easily check that keys(%hash) ==
values(%hash)
- %base_hash= ( pi => 'pi', e => 'e', i => 'i' );
- $array = [ qw(pi e i) ];
- $values = [ qw(pi e i) ];
- $hash = { %base_hash } ;
- $data = {
- hash => { %base_hash },
- array => [ @$array ],
- };
-}
-
-package Foo;
-sub new {
- my $self = {
- hash => { %base_hash },
- array => [@{$main::array}]
- };
- bless $self, shift;
-}
-sub hash { no overloading; $_[0]->{hash} };
-sub array { no overloading; $_[0]->{array} };
-
-package Foo::Overload::Array;
-sub new { return bless [ qw/foo bar/ ], shift }
-use overload '@{}' => sub { $main::array }, fallback => 1;
-
-package Foo::Overload::Hash;
-sub new { return bless { qw/foo bar/ }, shift }
-use overload '%{}' => sub { $main::hash }, fallback => 1;
-
-package Foo::Overload::Both;
-sub new { return bless { qw/foo bar/ }, shift }
-use overload '%{}' => sub { $main::hash },
- '@{}' => sub { $main::array }, fallback => 1;
-
-package Foo::Overload::HashOnArray;
-sub new { return bless [ qw/foo bar/ ], shift }
-use overload '%{}' => sub { $main::hash }, fallback => 1;
-
-package Foo::Overload::ArrayOnHash;
-sub new { return bless { qw/foo bar/ }, shift }
-use overload '@{}' => sub { $main::array }, fallback => 1;
**** PATCH TRUNCATED AT 2000 LINES -- 608 NOT SHOWN ****
--
Perl5 Master Repository
