diff options
author | Aaron Crane <arc@cpan.org> | 2015-06-11 17:24:13 +0100 |
---|---|---|
committer | Aaron Crane <arc@cpan.org> | 2015-07-13 14:08:34 +0100 |
commit | 262309092c2de925e7ae4a527174f8dc2a0ec7b7 (patch) | |
tree | fc20e8ab0b42c87c232e3b233556fafe2ac85076 | |
parent | de6cb0abd243e5772b9783a2cbeef5755a8267d6 (diff) | |
download | perl-262309092c2de925e7ae4a527174f8dc2a0ec7b7.tar.gz |
Delete experimental autoderef feature
-rw-r--r-- | doop.c | 4 | ||||
-rw-r--r-- | ext/Opcode/Opcode.pm | 4 | ||||
-rw-r--r-- | lib/B/Deparse-core.t | 41 | ||||
-rw-r--r-- | lib/B/Deparse.t | 13 | ||||
-rw-r--r-- | lib/B/Op_private.pm | 7 | ||||
-rw-r--r-- | lib/locale.t | 12 | ||||
-rw-r--r-- | lib/warnings.pm | 89 | ||||
-rw-r--r-- | op.c | 59 | ||||
-rw-r--r-- | opcode.h | 27 | ||||
-rw-r--r-- | opnames.h | 29 | ||||
-rw-r--r-- | pod/perldelta.pod | 8 | ||||
-rw-r--r-- | pod/perldiag.pod | 120 | ||||
-rw-r--r-- | pod/perlfunc.pod | 124 | ||||
-rw-r--r-- | pod/perlsub.pod | 10 | ||||
-rw-r--r-- | pp.c | 43 | ||||
-rw-r--r-- | pp_proto.h | 1 | ||||
-rw-r--r-- | regen/op_private | 2 | ||||
-rwxr-xr-x | regen/opcode.pl | 1 | ||||
-rw-r--r-- | regen/opcodes | 5 | ||||
-rw-r--r-- | regen/warnings.pl | 4 | ||||
-rw-r--r-- | t/lib/croak/op | 12 | ||||
-rw-r--r-- | t/lib/warnings/op | 56 | ||||
-rw-r--r-- | t/op/coresubs.t | 12 | ||||
-rw-r--r-- | t/op/cproto.t | 16 | ||||
-rw-r--r-- | t/op/kvaslice.t | 20 | ||||
-rw-r--r-- | t/op/kvhslice.t | 20 | ||||
-rw-r--r-- | t/op/push.t | 38 | ||||
-rw-r--r-- | t/op/smartkve.t | 400 | ||||
-rw-r--r-- | t/op/splice.t | 4 | ||||
-rw-r--r-- | t/op/tie_fetch_count.t | 10 | ||||
-rw-r--r-- | t/op/unshift.t | 35 | ||||
-rw-r--r-- | warnings.h | 23 |
32 files changed, 298 insertions, 951 deletions
@@ -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 c9a3f15f47..78ffd54f7e 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 981c74e673..b97cc71327 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 2fb5b7580c..b4874a4a62 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 512f66a541..c9db867f05 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 rv2gv rv2hv rv2sv); $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 rv2gv rv2hv rv2sv)], 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 3f37457036..1ebd0ce39c 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 e47ced4f3e..332f7c1772 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 @@ -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,14 @@ 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) { + /* diag_listed_as: Experimental push on scalar is now forbidden */ + 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 +12020,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 +12030,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 +12043,13 @@ Perl_ck_each(pTHX_ OP *o) /* we let ck_fun handle it */ break; default: - OpTYPE_set(o, ref_type); - scalar(kid); + /* diag_listed_as: Experimental keys on scalar is now forbidden */ + 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 +14172,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: @@ -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_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, akeys, avalues, each, values, pop, shift, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, reach, rvalues, fc, anonconst */ + 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_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, akeys, avalues, each, values, pop, shift, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */ 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, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */ 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), @@ -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 ae26fbb327..b3114a9844 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 159b9ac0b6..2723231553 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,42 @@ L<perlrecharclass/Extended Bracketed Character Classes>. use feature "signatures"; sub foo ($left, $right) { ... } +=item Experimental each on scalar is now forbidden + +(F) An experimental feature added in Perl 5.14 allowed C<each> 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 keys on scalar is now forbidden + +(F) An experimental feature added in Perl 5.14 allowed C<keys> 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 push on scalar is now forbidden + +(F) An experimental feature added in Perl 5.14 allowed C<push> 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 pop on scalar is now forbidden + +(F) An experimental feature added in Perl 5.14 allowed C<pop> 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 shift on scalar is now forbidden + +(F) An experimental feature added in Perl 5.14 allowed C<shift> 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 splice on scalar is now forbidden + +(F) An experimental feature added in Perl 5.14 allowed C<splice> 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: @@ -2131,6 +2159,18 @@ L<perlrecharclass/Extended Bracketed Character Classes>. use feature 'lexical_subs'; my sub foo { ... } +=item Experimental unshift on scalar is now forbidden + +(F) An experimental feature added in Perl 5.14 allowed C<unshift> 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 values on scalar is now forbidden + +(F) An experimental feature added in Perl 5.14 allowed 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 Explicit blessing to '' (assuming package main) (W misc) You are blessing a reference to a zero length string. This has @@ -2961,14 +3001,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 +4626,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 +4845,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 +5369,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 +5449,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 +5966,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 +6341,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 +6880,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 a3f612d39e..17180caf70 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 48f178ffa3..de2cc1091f 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 @@ -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 7f9d122333..96934ffc6f 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/regen/op_private b/regen/op_private index 06ebca6f76..bcc1c212fa 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 fe105846d6..50029bd1ae 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 8d07eedc24..9ea0753ffe 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/warnings.pl b/regen/warnings.pl index be33087e11..c4cc19c716 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 2d2887d9b2..cd3a6544e3 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 477fdad286..d2f8e577d2 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 6fec5f4c75..c18fdcde93 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 b2f07f76c1..aace8aa036 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 16ee4467f2..aec9a97801 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 a5357adb85..2bc633423f 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 f4b034f81b..c94c91953f 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 1b54adccb8..d93dde142e 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; - -package main; - -use constant CONST_HASH => { %base_hash }; -use constant CONST_ARRAY => [ @$array ]; - -my %a_hash = %base_hash; -my @an_array = @$array; -sub hash_sub { return \%a_hash; } -sub array_sub { return \@an_array; } - -my $obj = Foo->new; - -my ($empty, $h_expect, $a_expect, @tmp, @tmp2, $k, $v); - -# Keys -- void - -keys $hash; pass('Void: keys $hash;'); -keys $data->{hash}; pass('Void: keys $data->{hash};'); -keys CONST_HASH; pass('Void: keys CONST_HASH;'); -keys CONST_HASH(); pass('Void: keys CONST_HASH();'); -keys hash_sub(); pass('Void: keys hash_sub();'); -keys hash_sub; pass('Void: keys hash_sub;'); -keys $obj->hash; pass('Void: keys $obj->hash;'); -keys $array; pass('Void: keys $array;'); -keys $data->{array}; pass('Void: keys $data->{array};'); -keys CONST_ARRAY; pass('Void: keys CONST_ARRAY;'); -keys CONST_ARRAY(); pass('Void: keys CONST_ARRAY();'); -keys array_sub; pass('Void: keys array_sub;'); -keys array_sub(); pass('Void: keys array_sub();'); -keys $obj->array; pass('Void: keys $obj->array;'); - -# Keys -- scalar - -is(keys $hash ,3, 'Scalar: keys $hash'); -is(keys $data->{hash} ,3, 'Scalar: keys $data->{hash}'); -is(keys CONST_HASH ,3, 'Scalar: keys CONST_HASH'); -is(keys CONST_HASH() ,3, 'Scalar: keys CONST_HASH()'); -is(keys hash_sub ,3, 'Scalar: keys hash_sub'); -is(keys hash_sub() ,3, 'Scalar: keys hash_sub()'); -is(keys $obj->hash ,3, 'Scalar: keys $obj->hash'); -is(keys $array ,3, 'Scalar: keys $array'); -is(keys $data->{array} ,3, 'Scalar: keys $data->{array}'); -is(keys CONST_ARRAY ,3, 'Scalar: keys CONST_ARRAY'); -is(keys CONST_ARRAY() ,3, 'Scalar: keys CONST_ARRAY()'); -is(keys array_sub ,3, 'Scalar: keys array_sub'); -is(keys array_sub() ,3, 'Scalar: keys array_sub()'); -is(keys $obj->array ,3, 'Scalar: keys $obj->array'); - -# Keys -- list - -$h_expect = j(sort keys %base_hash); -$a_expect = j(keys @$array); - -is(j(sort keys $hash) ,$h_expect, 'List: sort keys $hash'); -is(j(sort keys $data->{hash}) ,$h_expect, 'List: sort keys $data->{hash}'); -is(j(sort keys CONST_HASH) ,$h_expect, 'List: sort keys CONST_HASH'); -is(j(sort keys CONST_HASH()) ,$h_expect, 'List: sort keys CONST_HASH()'); -is(j(sort keys hash_sub) ,$h_expect, 'List: sort keys hash_sub'); -is(j(sort keys hash_sub()) ,$h_expect, 'List: sort keys hash_sub()'); -is(j(sort keys $obj->hash) ,$h_expect, 'List: sort keys $obj->hash'); - -is(j(keys $hash) ,j(values $hash), 'List: keys $hash == values $hash'); -is(j(keys $data->{hash}) ,j(values $data->{hash}), 'List: keys $data->{hash} == values $data->{hash}'); -is(j(keys CONST_HASH) ,j(values CONST_HASH), 'List: keys CONST_HASH == values CONST_HASH'); -is(j(keys CONST_HASH()) ,j(values CONST_HASH()), 'List: keys CONST_HASH() == values CONST_HASH()'); -is(j(keys hash_sub) ,j(values hash_sub), 'List: keys hash_sub == values hash_sub'); -is(j(keys hash_sub()) ,j(values hash_sub()), 'List: keys hash_sub() == values hash_sub()'); -is(j(keys $obj->hash) ,j(values $obj->hash), 'List: keys $obj->hash == values obj->hash'); - -is(j(keys $array) ,$a_expect, 'List: keys $array'); -is(j(keys $data->{array}) ,$a_expect, 'List: keys $data->{array}'); -is(j(keys CONST_ARRAY) ,$a_expect, 'List: keys CONST_ARRAY'); -is(j(keys CONST_ARRAY()) ,$a_expect, 'List: keys CONST_ARRAY()'); -is(j(keys array_sub) ,$a_expect, 'List: keys array_sub'); -is(j(keys array_sub()) ,$a_expect, 'List: keys array_sub()'); -is(j(keys $obj->array) ,$a_expect, 'List: keys $obj->array'); - -# Keys -- vivification -undef $empty; -eval { keys $empty->{hash} }; -ok(defined $empty, - 'Vivify: $empty (after keys $empty->{hash}) is HASHREF'); -ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); - -# Keys -- lvalue -$_{foo} = "bar"; -keys \%_ = 65; -is scalar %_, '1/128', 'keys $hashref as lvalue'; -eval 'keys \@_ = 65'; -like $@, qr/Can't modify keys on reference in scalar assignment/, - 'keys $arrayref as lvalue dies'; +my $empty; # Keys -- errors -$errpat = qr/ - (?-x:Type of argument to keys on reference must be unblessed hashref or) - (?-x: arrayref) -/x; +$errpat = qr/Experimental keys on scalar is now forbidden/; eval "keys undef"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: keys undef throws error' ); undef $empty; eval q"keys $empty"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: keys $undef throws error' ); is($empty, undef, 'keys $undef does not vivify $undef'); eval "keys 3"; -ok($@ =~ qr/Type of arg 1 to keys must be hash/, +like($@, qr/Type of arg 1 to keys must be hash/, 'Errors: keys CONSTANT throws error' ); eval "keys qr/foo/"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: keys qr/foo/ throws error' ); eval q"keys $hash qw/fo bar/"; -ok($@ =~ qr/syntax error/, +like($@, $errpat, 'Errors: keys $hash, @stuff throws error' ) or print "# Got: $@"; -# Values -- void - -values $hash; pass('Void: values $hash;'); -values $data->{hash}; pass('Void: values $data->{hash};'); -values CONST_HASH; pass('Void: values CONST_HASH;'); -values CONST_HASH(); pass('Void: values CONST_HASH();'); -values hash_sub(); pass('Void: values hash_sub();'); -values hash_sub; pass('Void: values hash_sub;'); -values $obj->hash; pass('Void: values $obj->hash;'); -values $array; pass('Void: values $array;'); -values $data->{array}; pass('Void: values $data->{array};'); -values CONST_ARRAY; pass('Void: values CONST_ARRAY;'); -values CONST_ARRAY(); pass('Void: values CONST_ARRAY();'); -values array_sub; pass('Void: values array_sub;'); -values array_sub(); pass('Void: values array_sub();'); -values $obj->array; pass('Void: values $obj->array;'); - -# Values -- scalar - -is(values $hash ,3, 'Scalar: values $hash'); -is(values $data->{hash} ,3, 'Scalar: values $data->{hash}'); -is(values CONST_HASH ,3, 'Scalar: values CONST_HASH'); -is(values CONST_HASH() ,3, 'Scalar: values CONST_HASH()'); -is(values hash_sub ,3, 'Scalar: values hash_sub'); -is(values hash_sub() ,3, 'Scalar: values hash_sub()'); -is(values $obj->hash ,3, 'Scalar: values $obj->hash'); -is(values $array ,3, 'Scalar: values $array'); -is(values $data->{array} ,3, 'Scalar: values $data->{array}'); -is(values CONST_ARRAY ,3, 'Scalar: values CONST_ARRAY'); -is(values CONST_ARRAY() ,3, 'Scalar: values CONST_ARRAY()'); -is(values array_sub ,3, 'Scalar: values array_sub'); -is(values array_sub() ,3, 'Scalar: values array_sub()'); -is(values $obj->array ,3, 'Scalar: values $obj->array'); - -# Values -- list - -$h_expect = j(sort values %base_hash); -$a_expect = j(values @$array); - -is(j(sort values $hash) ,$h_expect, 'List: sort values $hash'); -is(j(sort values $data->{hash}) ,$h_expect, 'List: sort values $data->{hash}'); -is(j(sort values CONST_HASH) ,$h_expect, 'List: sort values CONST_HASH'); -is(j(sort values CONST_HASH()) ,$h_expect, 'List: sort values CONST_HASH()'); -is(j(sort values hash_sub) ,$h_expect, 'List: sort values hash_sub'); -is(j(sort values hash_sub()) ,$h_expect, 'List: sort values hash_sub()'); -is(j(sort values $obj->hash) ,$h_expect, 'List: sort values $obj->hash'); - -is(j(values $hash) ,j(keys $hash), 'List: values $hash == keys $hash'); -is(j(values $data->{hash}) ,j(keys $data->{hash}), 'List: values $data->{hash} == keys $data->{hash}'); -is(j(values CONST_HASH) ,j(keys CONST_HASH), 'List: values CONST_HASH == keys CONST_HASH'); -is(j(values CONST_HASH()) ,j(keys CONST_HASH()), 'List: values CONST_HASH() == keys CONST_HASH()'); -is(j(values hash_sub) ,j(keys hash_sub), 'List: values hash_sub == keys hash_sub'); -is(j(values hash_sub()) ,j(keys hash_sub()), 'List: values hash_sub() == keys hash_sub()'); -is(j(values $obj->hash) ,j(keys $obj->hash), 'List: values $obj->hash == keys $obj->hash'); - -is(j(values $array) ,$a_expect, 'List: values $array'); -is(j(values $data->{array}) ,$a_expect, 'List: values $data->{array}'); -is(j(values CONST_ARRAY) ,$a_expect, 'List: values CONST_ARRAY'); -is(j(values CONST_ARRAY()) ,$a_expect, 'List: values CONST_ARRAY()'); -is(j(values array_sub) ,$a_expect, 'List: values array_sub'); -is(j(values array_sub()) ,$a_expect, 'List: values array_sub()'); -is(j(values $obj->array) ,$a_expect, 'List: values $obj->array'); - -# Values -- vivification -undef $empty; -eval { values $empty->{hash} }; -ok(defined $empty, - 'Vivify: $empty (after values $empty->{hash}) is HASHREF'); -ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); - # Values -- errors -$errpat = qr/ - (?-x:Type of argument to values on reference must be unblessed hashref or) - (?-x: arrayref) -/x; +$errpat = qr/Experimental values on scalar is now forbidden/; eval "values undef"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: values undef throws error' ); undef $empty; eval q"values $empty"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: values $undef throws error' ); is($empty, undef, 'values $undef does not vivify $undef'); eval "values 3"; -ok($@ =~ qr/Type of arg 1 to values must be hash/, +like($@, qr/Type of arg 1 to values must be hash/, 'Errors: values CONSTANT throws error' ); eval "values qr/foo/"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: values qr/foo/ throws error' ); eval q"values $hash qw/fo bar/"; -ok($@ =~ qr/syntax error/, +like($@, $errpat, 'Errors: values $hash, @stuff throws error' ) or print "# Got: $@"; -# Each -- void - -each $hash; pass('Void: each $hash'); -each $data->{hash}; pass('Void: each $data->{hash}'); -each CONST_HASH; pass('Void: each CONST_HASH'); -each CONST_HASH(); pass('Void: each CONST_HASH()'); -each hash_sub(); pass('Void: each hash_sub()'); -each hash_sub; pass('Void: each hash_sub'); -each $obj->hash; pass('Void: each $obj->hash'); -each $array; pass('Void: each $array'); -each $data->{array}; pass('Void: each $data->{array}'); -each CONST_ARRAY; pass('Void: each CONST_ARRAY'); -each CONST_ARRAY(); pass('Void: each CONST_ARRAY()'); -each array_sub; pass('Void: each array_sub'); -each array_sub(); pass('Void: each array_sub()'); -each $obj->array; pass('Void: each $obj->array'); - -# Reset iterators - -keys $hash; -keys $data->{hash}; -keys CONST_HASH; -keys CONST_HASH(); -keys hash_sub(); -keys hash_sub; -keys $obj->hash; -keys $array; -keys $data->{array}; -keys CONST_ARRAY; -keys CONST_ARRAY(); -keys array_sub; -keys array_sub(); -keys $obj->array; - -# Each -- scalar - -@tmp=(); while(defined( $k = each $hash)) {push @tmp,$k}; is(j(@tmp),j(keys $hash), 'Scalar: each $hash'); -@tmp=(); while(defined( $k = each $data->{hash})){push @tmp,$k}; is(j(@tmp),j(keys $data->{hash}), 'Scalar: each $data->{hash}'); -@tmp=(); while(defined( $k = each CONST_HASH)){push @tmp,$k}; is(j(@tmp),j(keys CONST_HASH), 'Scalar: each CONST_HASH'); -@tmp=(); while(defined( $k = each CONST_HASH())){push @tmp,$k}; is(j(@tmp),j(keys CONST_HASH()), 'Scalar: each CONST_HASH()'); -@tmp=(); while(defined( $k = each hash_sub())){push @tmp,$k}; is(j(@tmp),j(keys hash_sub()), 'Scalar: each hash_sub()'); -@tmp=(); while(defined( $k = each hash_sub)){push @tmp,$k}; is(j(@tmp),j(keys hash_sub), 'Scalar: each hash_sub'); -@tmp=(); while(defined( $k = each $obj->hash)){push @tmp,$k}; is(j(@tmp),j(keys $obj->hash), 'Scalar: each $obj->hash'); -@tmp=(); while(defined( $k = each $array)){push @tmp,$k}; is(j(@tmp),j(keys $array), 'Scalar: each $array'); -@tmp=(); while(defined( $k = each $data->{array})){push @tmp,$k}; is(j(@tmp),j(keys $data->{array}), 'Scalar: each $data->{array}'); -@tmp=(); while(defined( $k = each CONST_ARRAY)){push @tmp,$k}; is(j(@tmp),j(keys CONST_ARRAY), 'Scalar: each CONST_ARRAY'); -@tmp=(); while(defined( $k = each CONST_ARRAY())){push @tmp,$k}; is(j(@tmp),j(keys CONST_ARRAY()), 'Scalar: each CONST_ARRAY()'); -@tmp=(); while(defined( $k = each array_sub)){push @tmp,$k}; is(j(@tmp),j(keys array_sub), 'Scalar: each array_sub'); -@tmp=(); while(defined( $k = each array_sub())){push @tmp,$k}; is(j(@tmp),j(keys array_sub()), 'Scalar: each array_sub()'); -@tmp=(); while(defined( $k = each $obj->array)){push @tmp,$k}; is(j(@tmp),j(keys $obj->array), 'Scalar: each $obj->array'); - -# Each -- list - -@tmp=@tmp2=(); while(($k,$v) = each $hash) {push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $hash, values $hash), 'List: each $hash'); -@tmp=@tmp2=(); while(($k,$v) = each $data->{hash}){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $data->{hash}, values $data->{hash}), 'List: each $data->{hash}'); -@tmp=@tmp2=(); while(($k,$v) = each CONST_HASH){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys CONST_HASH, values CONST_HASH), 'List: each CONST_HASH'); -@tmp=@tmp2=(); while(($k,$v) = each CONST_HASH()){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys CONST_HASH(), values CONST_HASH()), 'List: each CONST_HASH()'); -@tmp=@tmp2=(); while(($k,$v) = each hash_sub()){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys hash_sub(), values hash_sub()), 'List: each hash_sub()'); -@tmp=@tmp2=(); while(($k,$v) = each hash_sub){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys hash_sub, values hash_sub), 'List: each hash_sub'); -@tmp=@tmp2=(); while(($k,$v) = each $obj->hash){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $obj->hash, values $obj->hash), 'List: each $obj->hash'); -@tmp=@tmp2=(); while(($k,$v) = each $array){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $array, values $array), 'List: each $array'); -@tmp=@tmp2=(); while(($k,$v) = each $data->{array}){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $data->{array}, values $data->{array}), 'List: each $data->{array}'); -@tmp=@tmp2=(); while(($k,$v) = each CONST_ARRAY){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys CONST_ARRAY, values CONST_ARRAY), 'List: each CONST_ARRAY'); -@tmp=@tmp2=(); while(($k,$v) = each CONST_ARRAY()){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys CONST_ARRAY(), values CONST_ARRAY()), 'List: each CONST_ARRAY()'); -@tmp=@tmp2=(); while(($k,$v) = each array_sub){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys array_sub, values array_sub), 'List: each array_sub'); -@tmp=@tmp2=(); while(($k,$v) = each array_sub()){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys array_sub(), values array_sub()), 'List: each array_sub()'); -@tmp=@tmp2=(); while(($k,$v) = each $obj->array){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $obj->array, values $obj->array), 'List: each $obj->array'); - -# Each -- vivification -undef $empty; -eval { each $empty->{hash} }; -ok(defined $empty, - 'Vivify: $empty (after each $empty->{hash}) is HASHREF'); -ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); - # Each -- errors -$errpat = qr/ - (?-x:Type of argument to each on reference must be unblessed hashref or) - (?-x: arrayref) -/x; +$errpat = qr/Experimental each on scalar is now forbidden/; eval "each undef"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: each undef throws error' ); undef $empty; eval q"each $empty"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: each $undef throws error' ); is($empty, undef, 'each $undef does not vivify $undef'); eval "each 3"; -ok($@ =~ qr/Type of arg 1 to each must be hash/, +like($@, qr/Type of arg 1 to each must be hash/, 'Errors: each CONSTANT throws error' ); eval "each qr/foo/"; -ok($@ =~ $errpat, +like($@, $errpat, 'Errors: each qr/foo/ throws error' ); eval q"each $hash qw/foo bar/"; -ok($@ =~ qr/syntax error/, +like($@, $errpat, 'Errors: each $hash, @stuff throws error' ) or print "# Got: $@"; -# Overloaded objects -my $over_a = Foo::Overload::Array->new; -my $over_h = Foo::Overload::Hash->new; -my $over_b = Foo::Overload::Both->new; -my $over_h_a = Foo::Overload::HashOnArray->new; -my $over_a_h = Foo::Overload::ArrayOnHash->new; - -{ - my $warn = ''; - local $SIG{__WARN__} = sub { $warn = shift }; - - $errpat = qr/ - (?-x:Type of argument to keys on reference must be unblessed hashref or) - (?-x: arrayref) - /x; - - eval { keys $over_a }; - like($@, $errpat, "Overload: array dereference"); - is($warn, '', "no warning issued"); $warn = ''; - - eval { keys $over_h }; - like($@, $errpat, "Overload: hash dereference"); - is($warn, '', "no warning issued"); $warn = ''; - - eval { keys $over_b }; - like($@, $errpat, "Overload: ambiguous dereference (both)"); - is($warn, '', "no warning issued"); $warn = ''; - - eval { keys $over_h_a }; - like($@, $errpat, "Overload: ambiguous dereference"); - is($warn, '', "no warning issued"); $warn = ''; - - eval { keys $over_a_h }; - like($@, $errpat, "Overload: ambiguous dereference"); - is($warn, '', "no warning issued"); $warn = ''; -} - use feature 'refaliasing'; my $a = 7; our %h; \$h{f} = \$a; -($a, $b) = each \%h; -is "$a $b", "f 7", 'each \%hash in list assignment'; +($a, $b) = each %h; +is "$a $b", "f 7", 'each %hash in list assignment'; $a = 7; -($a, $b) = (3, values \%h); -is "$a $b", "3 7", 'values \%hash in list assignment'; +($a, $b) = (3, values %h); +is "$a $b", "3 7", 'values %hash in list assignment'; *a = sub { \@_ }->($a); $a = 7; -($a, $b) = each \our @a; -is "$a $b", "0 7", 'each \@array in list assignment'; +($a, $b) = each our @a; +is "$a $b", "0 7", 'each @array in list assignment'; $a = 7; -($a, $b) = (3, values \@a); -is "$a $b", "3 7", 'values \@array in list assignment'; +($a, $b) = (3, values @a); +is "$a $b", "3 7", 'values @array in list assignment'; diff --git a/t/op/splice.t b/t/op/splice.t index dde11f52ac..c0af5d397b 100644 --- a/t/op/splice.t +++ b/t/op/splice.t @@ -88,10 +88,6 @@ ok( ! Foo->isa('Bar'), 'Foo is not a Bar'); splice @Foo::ISA, 0, 0, 'Bar'; ok( Foo->isa('Bar'), 'splice @ISA and make Foo a Bar'); -# Test undef first arg -eval { no warnings 'experimental';splice( $new_arrayref, 0, 0, 1, 2, 3 ) }; -like($@, qr/Not an ARRAY/, 'undefined first argument to splice'); - # Test arrays with nonexistent elements (crashes when it fails) @a = (); $#a++; diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t index 41fef0c339..82a8543d22 100644 --- a/t/op/tie_fetch_count.t +++ b/t/op/tie_fetch_count.t @@ -7,7 +7,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; set_up_inc('../lib'); - plan (tests => 347); + plan (tests => 345); } use strict; @@ -171,17 +171,9 @@ tie my $var1 => 'main', \1; $dummy = $$var1 ; check_count '${}'; tie my $var2 => 'main', []; $dummy = @$var2 ; check_count '@{}'; -{ - no warnings 'experimental::autoderef'; - $dummy = shift $var2 ; check_count 'shift arrayref'; -} tie my $var3 => 'main', {}; $dummy = %$var3 ; check_count '%{}'; { - no warnings 'experimental::autoderef'; - $dummy = keys $var3 ; check_count 'keys hashref'; -} -{ no strict 'refs'; tie my $var4 => 'main', *]; $dummy = *$var4 ; check_count '*{}'; diff --git a/t/op/unshift.t b/t/op/unshift.t index 7782b2a591..66fd0ff86a 100644 --- a/t/op/unshift.t +++ b/t/op/unshift.t @@ -5,51 +5,34 @@ BEGIN { require "./test.pl"; } -plan(36); +plan(18); @array = (1, 2, 3); -$aref = [1, 2, 3]; -no warnings 'experimental::autoderef'; { no warnings 'syntax'; $count3 = unshift (@array); - $count3r = unshift ($aref); } is(join(' ',@array), '1 2 3', 'unshift null'); cmp_ok($count3, '==', 3, 'unshift count == 3'); -is(join(' ',@$aref), '1 2 3', 'unshift null (ref)'); -cmp_ok($count3r, '==', 3, 'unshift count == 3 (ref)'); $count3_2 = unshift (@array, ()); is(join(' ',@array), '1 2 3', 'unshift null empty'); cmp_ok($count3_2, '==', 3, 'unshift count == 3 again'); -$count3_2r = unshift ($aref, ()); -is(join(' ',@$aref), '1 2 3', 'unshift null empty (ref)'); -cmp_ok($count3_2r, '==', 3, 'unshift count == 3 again (ref)'); $count4 = unshift (@array, 0); is(join(' ',@array), '0 1 2 3', 'unshift singleton list'); cmp_ok($count4, '==', 4, 'unshift count == 4'); -$count4r = unshift ($aref, 0); -is(join(' ',@$aref), '0 1 2 3', 'unshift singleton list (ref)'); -cmp_ok($count4r, '==', 4, 'unshift count == 4 (ref)'); $count7 = unshift (@array, 3, 2, 1); is(join(' ',@array), '3 2 1 0 1 2 3', 'unshift list'); cmp_ok($count7, '==', 7, 'unshift count == 7'); -$count7r = unshift ($aref, 3, 2, 1); -is(join(' ',@$aref), '3 2 1 0 1 2 3', 'unshift list (ref)'); -cmp_ok($count7r, '==', 7, 'unshift count == 7 (ref)'); @list = (5, 4); $count9 = unshift (@array, @list); is(join(' ',@array), '5 4 3 2 1 0 1 2 3', 'unshift array'); cmp_ok($count9, '==', 9, 'unshift count == 9'); -$count9r = unshift ($aref, @list); -is(join(' ',@$aref), '5 4 3 2 1 0 1 2 3', 'unshift array (ref)'); -cmp_ok($count9r, '==', 9, 'unshift count == 9 (ref)'); @list = (7); @@ -57,47 +40,31 @@ cmp_ok($count9r, '==', 9, 'unshift count == 9 (ref)'); $count11 = unshift (@array, @list, @list2); is(join(' ',@array), '7 6 5 4 3 2 1 0 1 2 3', 'unshift arrays'); cmp_ok($count11, '==', 11, 'unshift count == 11'); -$count11r = unshift ($aref, @list, @list2); -is(join(' ',@$aref), '7 6 5 4 3 2 1 0 1 2 3', 'unshift arrays (ref)'); -cmp_ok($count11r, '==', 11, 'unshift count == 11 (ref)'); # ignoring counts @alpha = ('y', 'z'); -$alpharef = ['y', 'z']; { no warnings 'syntax'; unshift (@alpha); - unshift ($alpharef); } is(join(' ',@alpha), 'y z', 'void unshift null'); -is(join(' ',@$alpharef), 'y z', 'void unshift null (ref)'); unshift (@alpha, ()); is(join(' ',@alpha), 'y z', 'void unshift null empty'); -unshift ($alpharef, ()); -is(join(' ',@$alpharef), 'y z', 'void unshift null empty (ref)'); unshift (@alpha, 'x'); is(join(' ',@alpha), 'x y z', 'void unshift singleton list'); -unshift ($alpharef, 'x'); -is(join(' ',@$alpharef), 'x y z', 'void unshift singleton list (ref)'); unshift (@alpha, 'u', 'v', 'w'); is(join(' ',@alpha), 'u v w x y z', 'void unshift list'); -unshift ($alpharef, 'u', 'v', 'w'); -is(join(' ',@$alpharef), 'u v w x y z', 'void unshift list (ref)'); @bet = ('s', 't'); unshift (@alpha, @bet); is(join(' ',@alpha), 's t u v w x y z', 'void unshift array'); -unshift ($alpharef, @bet); -is(join(' ',@$alpharef), 's t u v w x y z', 'void unshift array (ref)'); @bet = ('q'); @gimel = ('r'); unshift (@alpha, @bet, @gimel); is(join(' ',@alpha), 'q r s t u v w x y z', 'void unshift arrays'); -unshift ($alpharef, @bet, @gimel); -is(join(' ',@$alpharef), 'q r s t u v w x y z', 'void unshift arrays (ref)'); diff --git a/warnings.h b/warnings.h index 24fe243464..4e91ae6ae0 100644 --- a/warnings.h +++ b/warnings.h @@ -97,21 +97,20 @@ /* Warnings Categories added in Perl 5.019 */ -#define WARN_EXPERIMENTAL__AUTODEREF 56 -#define WARN_EXPERIMENTAL__POSTDEREF 57 -#define WARN_EXPERIMENTAL__SIGNATURES 58 -#define WARN_SYSCALLS 59 +#define WARN_EXPERIMENTAL__POSTDEREF 56 +#define WARN_EXPERIMENTAL__SIGNATURES 57 +#define WARN_SYSCALLS 58 /* Warnings Categories added in Perl 5.021 */ -#define WARN_EXPERIMENTAL__BITWISE 60 -#define WARN_EXPERIMENTAL__CONST_ATTR 61 -#define WARN_EXPERIMENTAL__RE_STRICT 62 -#define WARN_EXPERIMENTAL__REFALIASING 63 -#define WARN_EXPERIMENTAL__WIN32_PERLIO 64 -#define WARN_LOCALE 65 -#define WARN_MISSING 66 -#define WARN_REDUNDANT 67 +#define WARN_EXPERIMENTAL__BITWISE 59 +#define WARN_EXPERIMENTAL__CONST_ATTR 60 +#define WARN_EXPERIMENTAL__RE_STRICT 61 +#define WARN_EXPERIMENTAL__REFALIASING 62 +#define WARN_EXPERIMENTAL__WIN32_PERLIO 63 +#define WARN_LOCALE 64 +#define WARN_MISSING 65 +#define WARN_REDUNDANT 66 #define WARNsize 17 #define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125" |