diff options
| -rw-r--r-- | MANIFEST | 3 | ||||
| -rw-r--r-- | cop.h | 24 | ||||
| -rw-r--r-- | dist/B-Deparse/Deparse.pm | 43 | ||||
| -rw-r--r-- | dist/B-Deparse/t/deparse.t | 1 | ||||
| -rw-r--r-- | dump.c | 3 | ||||
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | ext/B/B.pm | 2 | ||||
| -rw-r--r-- | ext/B/B.xs | 5 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 11 | ||||
| -rw-r--r-- | ext/B/t/concise-xs.t | 2 | ||||
| -rw-r--r-- | lib/Tie/Array.pm | 5 | ||||
| -rw-r--r-- | mg.c | 13 | ||||
| -rw-r--r-- | op.c | 49 | ||||
| -rw-r--r-- | op.h | 1 | ||||
| -rw-r--r-- | perl.h | 1 | ||||
| -rw-r--r-- | pod/perldata.pod | 8 | ||||
| -rw-r--r-- | pod/perldelta.pod | 10 | ||||
| -rw-r--r-- | pod/perldiag.pod | 25 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 10 | ||||
| -rw-r--r-- | pod/perlvar.pod | 24 | ||||
| -rw-r--r-- | pp.c | 64 | ||||
| -rw-r--r-- | pp_ctl.c | 1 | ||||
| -rw-r--r-- | pp_hot.c | 2 | ||||
| -rw-r--r-- | scope.c | 5 | ||||
| -rw-r--r-- | scope.h | 3 | ||||
| -rw-r--r-- | sv.c | 1 | ||||
| -rw-r--r-- | t/lib/warnings/op | 17 | ||||
| -rw-r--r-- | t/op/array.t | 35 | ||||
| -rw-r--r-- | t/op/array_base.aux | 5 | ||||
| -rw-r--r-- | t/op/array_base.t | 81 | ||||
| -rw-r--r-- | t/op/each_array.t | 43 | ||||
| -rw-r--r-- | t/op/index.t | 15 | ||||
| -rw-r--r-- | t/op/leaky-magic.t | 5 | ||||
| -rw-r--r-- | t/op/local.t | 12 | ||||
| -rw-r--r-- | t/porting/known_pod_issues.dat | 1 | ||||
| -rw-r--r-- | t/re/substr.t | 16 | ||||
| -rw-r--r-- | toke.c | 8 |
37 files changed, 83 insertions, 472 deletions
@@ -4881,8 +4881,7 @@ t/op/anonsub.t See if anonymous subroutines work t/op/append.t See if . works t/op/args.t See if operations on @_ work t/op/arith.t See if arithmetic works -t/op/array_base.aux Auxiliary file for the $[ test -t/op/array_base.t Tests for the $[, which is deprecated +t/op/array_base.t Tests for the remnant of $[ t/op/array.t See if array operations work t/op/assignwarn.t See if OP= operators warn correctly for undef targets t/op/attrhand.t See if attribute handlers work @@ -554,30 +554,6 @@ be zero. /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */ #define OutCopFILE(c) CopFILE(c) -/* If $[ is non-zero, it's stored in cop_hints under the key "$[", and - HINT_ARYBASE is set to indicate this. - Setting it is inefficient due to the need to create 2 mortal SVs, but as - using $[ is highly discouraged, no sane Perl code will be using it. */ -#define CopARYBASE_get(c) \ - ((CopHINTS_get(c) & HINT_ARYBASE) \ - ? SvIV(cop_hints_fetch_pvs((c), "$[", 0)) \ - : 0) -#define CopARYBASE_set(c, b) STMT_START { \ - if (b || ((c)->cop_hints & HINT_ARYBASE)) { \ - (c)->cop_hints |= HINT_ARYBASE; \ - if ((c) == &PL_compiling) { \ - SV *val = newSViv(b); \ - (void)hv_stores(GvHV(PL_hintgv), "$[", val); \ - mg_set(val); \ - PL_hints |= HINT_ARYBASE; \ - } else { \ - CopHINTHASH_set((c), \ - cophh_store_pvs(CopHINTHASH_get((c)), "$[", \ - sv_2mortal(newSViv(b)), 0)); \ - } \ - } \ - } STMT_END - /* FIXME NATIVE_HINTS if this is changed from op_private (see perl.h) */ #define CopHINTS_get(c) ((c)->cop_hints + 0) #define CopHINTS_set(c, h) STMT_START { \ diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index cb60bae653..4df3245c15 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -14,7 +14,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPf_MOD OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY - OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER + OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER OPpSORT_REVERSE SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG CVf_METHOD CVf_LVALUE @@ -26,7 +26,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring ($] < 5.009 ? 'PMf_SKIPWHITE' : qw(RXf_SKIPWHITE)), ($] < 5.011 ? 'CVf_LOCKED' : 'OPpREVERSE_INPLACE'), ($] < 5.013 ? () : 'PMf_NONDESTRUCT'); -$VERSION = "1.07"; +$VERSION = "1.08"; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -579,7 +579,6 @@ sub new { $self->{'use_dumper'} = 0; $self->{'use_tabs'} = 0; - $self->{'ambient_arybase'} = 0; $self->{'ambient_warnings'} = undef; # Assume no lexical warnings $self->{'ambient_hints'} = 0; $self->{'ambient_hinthash'} = undef; @@ -625,7 +624,6 @@ sub new { sub init { my $self = shift; - $self->{'arybase'} = $self->{'ambient_arybase'}; $self->{'warnings'} = defined ($self->{'ambient_warnings'}) ? $self->{'ambient_warnings'} & WARN_MASK : undef; @@ -709,7 +707,7 @@ sub coderef2text { sub ambient_pragmas { my $self = shift; - my ($arybase, $hint_bits, $warning_bits, $hinthash) = (0, 0); + my ($hint_bits, $warning_bits, $hinthash) = (0); while (@_ > 1) { my $name = shift(); @@ -736,10 +734,6 @@ sub ambient_pragmas { $hint_bits |= strict::bits(@names); } - elsif ($name eq '$[') { - $arybase = $val; - } - elsif ($name eq 'integer' || $name eq 'bytes' || $name eq 'utf8') { @@ -810,7 +804,6 @@ sub ambient_pragmas { croak "The ambient_pragmas method expects an even number of args"; } - $self->{'ambient_arybase'} = $arybase; $self->{'ambient_warnings'} = $warning_bits; $self->{'ambient_hints'} = $hint_bits; $self->{'ambient_hinthash'} = $hinthash; @@ -1399,7 +1392,7 @@ sub seq_subs { } # Notice how subs and formats are inserted between statements here; -# also $[ assignments and pragmas. +# also pragmas. sub pp_nextstate { my $self = shift; my($op, $cx) = @_; @@ -1412,11 +1405,6 @@ sub pp_nextstate { $self->{'curstash'} = $stash; } - if ($self->{'arybase'} != $op->arybase) { - push @text, '$[ = '. $op->arybase .";\n"; - $self->{'arybase'} = $op->arybase; - } - my $warnings = $op->warnings; my $warning_bits; if ($warnings->isa("B::SPECIAL") && $$warnings == 4) { @@ -2943,7 +2931,7 @@ sub pp_aelemfast_lex { my($op, $cx) = @_; my $name = $self->padname($op->targ); $name =~ s/^@/\$/; - return $name . "[" . ($op->private + $self->{'arybase'}) . "]"; + return $name . "[" . $op->private . "]"; } sub pp_aelemfast { @@ -2957,7 +2945,7 @@ sub pp_aelemfast { $name = $self->{'curstash'}."::$name" if $name !~ /::/ && $self->lex_in_scope('@'.$name); $name = '$' . $name; - return $name . "[" . ($op->private + $self->{'arybase'}) . "]"; + return $name . "[" . $op->private . "]"; } sub rv2x { @@ -3836,9 +3824,6 @@ sub const_sv { sub pp_const { my $self = shift; my($op, $cx) = @_; - if ($op->private & OPpCONST_ARYBASE) { - return '$['; - } # if ($op->private & OPpCONST_BARE) { # trouble with `=>' autoquoting # return $self->const_sv($op)->PV; # } @@ -3851,7 +3836,6 @@ sub dq { my $op = shift; my $type = $op->name; if ($type eq "const") { - return '$[' if $op->private & OPpCONST_ARYBASE; return uninterp(escape_str(unback($self->const_sv($op)->as_string))); } elsif ($type eq "concat") { my $first = $self->dq($op->first); @@ -4176,7 +4160,6 @@ sub re_dq { my $type = $op->name; if ($type eq "const") { - return '$[' if $op->private & OPpCONST_ARYBASE; my $unbacked = re_unback($self->const_sv($op)->as_string); return re_uninterp_extended(escape_extended_re($unbacked)) if $extended; @@ -4720,7 +4703,7 @@ after B<-MO=Deparse> should be given as separate strings. =head2 ambient_pragmas - $deparse->ambient_pragmas(strict => 'all', '$[' => $[); + $deparse->ambient_pragmas(strict => 'all'); The compilation of a subroutine can be affected by a few compiler directives, B<pragmas>. These are: @@ -4737,10 +4720,6 @@ use warnings; =item * -Assigning to the special variable $[ - -=item * - use integer; =item * @@ -4783,10 +4762,6 @@ expect. $deparse->ambient_pragmas(strict => 'subs refs'); -=item $[ - -Takes a number, the value of the array base $[. - =item bytes =item utf8 @@ -4840,7 +4815,6 @@ They exist principally so that you can write code like: $deparser->ambient_pragmas ( hint_bits => $hint_bits, warning_bits => $warning_bits, - '$[' => 0 + $[ ); } which specifies that the ambient pragmas are exactly those which @@ -4873,8 +4847,7 @@ the main:: package, the code will include a package declaration. =item * The only pragmas to be completely supported are: C<use warnings>, -C<use strict 'refs'>, C<use bytes>, and C<use integer>. (C<$[>, which -behaves like a pragma, is also supported.) +C<use strict 'refs'>, C<use bytes>, and C<use integer>. Excepting those listed above, we're currently unable to guarantee that B::Deparse will produce a pragma at the correct point in the program. diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index d32d1f4bae..f8b52eda0c 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -30,7 +30,6 @@ isa_ok($deparse, 'B::Deparse', 'instantiate a B::Deparse object'); $deparse->ambient_pragmas ( hint_bits => $hint_bits, warning_bits => $warning_bits, - '$[' => 0 + $[, '%^H' => $hinthash, ); } @@ -821,7 +821,6 @@ const struct flag_to_name op_const_names[] = { {OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"}, {OPpCONST_STRICT, ",STRICT"}, {OPpCONST_ENTERED, ",ENTERED"}, - {OPpCONST_ARYBASE, ",ARYBASE"}, {OPpCONST_BARE, ",BARE"}, {OPpCONST_WARNING, ",WARNING"} }; @@ -2990,8 +2989,6 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) sv_catpv(tmpsv, ",BARE"); if (o->op_private & OPpCONST_STRICT) sv_catpv(tmpsv, ",STRICT"); - if (o->op_private & OPpCONST_ARYBASE) - sv_catpv(tmpsv, ",ARYBASE"); if (o->op_private & OPpCONST_WARNING) sv_catpv(tmpsv, ",WARNING"); if (o->op_private & OPpCONST_ENTERED) @@ -1106,7 +1106,6 @@ Ap |void |save_padsv_and_mortalize|PADOFFSET off Ap |void |save_sptr |NN SV** sptr Ap |SV* |save_svref |NN SV** sptr Ap |void |save_pushptr |NULLOK void *const ptr|const int type -: Used by SAVECOPARYBASE() in op.c Ap |void |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type : Used by SAVESWITCHSTACK() in pp.c Ap |void |save_pushptrptr|NULLOK void *const ptr1 \ diff --git a/ext/B/B.pm b/ext/B/B.pm index 2f18065e4a..6857ae4d56 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -15,7 +15,7 @@ require Exporter; # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.31'; + $B::VERSION = '1.32'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index 0c44e45bad..1901edde9e 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1229,7 +1229,6 @@ pv(o) ST(0) = newSVpvn_flags(o->op_pv, strlen(o->op_pv), SVs_TEMP); #define COP_label(o) CopLABEL(o) -#define COP_arybase(o) CopARYBASE_get(o) MODULE = B PACKAGE = B::COP PREFIX = COP_ @@ -1270,6 +1269,10 @@ COP_stashpv(o) I32 COP_arybase(o) B::COP o + CODE: + RETVAL = 0; + OUTPUT: + RETVAL void COP_warnings(o) diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 055166751d..99d76af802 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -634,7 +634,7 @@ $priv{$_}{16} = "TARGMY" "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority", "setpriority", "time", "sleep"); $priv{$_}{4} = "REVERSED" for ("enteriter", "iter"); -@{$priv{"const"}}{4,8,16,32,64,128} = ("SHORT","STRICT","ENTERED",'$[',"BARE","WARN"); +@{$priv{"const"}}{4,8,16,64,128} = ("SHORT","STRICT","ENTERED","BARE","WARN"); $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM"; $priv{"list"}{64} = "GUESSED"; $priv{"delete"}{64} = "SLICE"; @@ -667,8 +667,8 @@ our %hints; # used to display each COP's op_hints values # strict refs, subs, vars @hints{2,512,1024} = ('$', '&', '*'); -# integers, locale, bytes, arybase -@hints{1,4,8,16,32} = ('i', 'l', 'b', '['); +# integers, locale, bytes +@hints{1,4,8,16} = ('i', 'l', 'b'); # block scope, localise %^H, $^OPEN (in), $^OPEN (out) @hints{256,131072,262144,524288} = ('{','%','<','>'); # overload new integer, float, binary, string, re @@ -856,9 +856,7 @@ sub concise_op { my $ln = $op->line; $loc .= ":$ln"; my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base); - my $arybase = $op->arybase; - $arybase = $arybase ? ' $[=' . $arybase : ""; - $h{arg} = "($label$stash $cseq $loc$arybase)"; + $h{arg} = "($label$stash $cseq $loc)"; if ($show_src) { fill_srclines($pathnm) unless exists $srclines{$pathnm}; # Would love to retain Jim's use of // but this code needs to be @@ -1550,7 +1548,6 @@ string if this is not a COP. Here are the symbols used: i integers l locale b bytes - [ arybase { block scope % localise %^H < open in diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t index c8f1b16494..697280c222 100644 --- a/ext/B/t/concise-xs.t +++ b/ext/B/t/concise-xs.t @@ -158,7 +158,7 @@ my $testpkgs = { OP_GLOB OP_STRINGIFY OPf_KIDS OPf_MOD OPf_REF OPf_SPECIAL OPf_STACKED OPf_WANT OPf_WANT_LIST OPf_WANT_SCALAR - OPf_WANT_VOID OPpCONST_ARYBASE OPpCONST_BARE OPpCONST_NOVER + OPf_WANT_VOID OPpCONST_BARE OPpCONST_NOVER OPpENTERSUB_AMPER OPpEXISTS_SUB OPpITER_REVERSED OPpLVAL_INTRO OPpOUR_INTRO OPpSLICE OPpSORT_DESCEND OPpSORT_INPLACE OPpSORT_INTEGER OPpSORT_NUMERIC diff --git a/lib/Tie/Array.pm b/lib/Tie/Array.pm index 4e980a81fc..767cfdd77a 100644 --- a/lib/Tie/Array.pm +++ b/lib/Tie/Array.pm @@ -3,7 +3,7 @@ package Tie::Array; use 5.006_001; use strict; use Carp; -our $VERSION = '1.04'; +our $VERSION = '1.05'; # Pod documentation after __END__ below. @@ -277,9 +277,6 @@ There is no support at present for tied @ISA. There is a potential conflict between magic entries needed to notice setting of @ISA, and those needed to implement 'tie'. -Very little consideration has been given to the behaviour of tied arrays -when C<$[> is not default value of zero. - =head1 AUTHOR Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt> @@ -1069,7 +1069,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '/': break; case '[': - sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop)); + sv_setiv(sv, 0); break; case '|': if (GvIO(PL_defoutgv)) @@ -2018,7 +2018,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_GETARYLEN; if (obj) { - sv_setiv(sv, AvFILL(obj) + CopARYBASE_get(PL_curcop)); + sv_setiv(sv, AvFILL(obj)); } else { SvOK_off(sv); } @@ -2034,7 +2034,7 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_SETARYLEN; if (obj) { - av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop)); + av_fill(obj, SvIV(sv)); } else { Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Attempt to set length of freed array"); @@ -2082,7 +2082,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) I32 i = found->mg_len; if (DO_UTF8(lsv)) sv_pos_b2u(lsv, &i); - sv_setiv(sv, i + CopARYBASE_get(PL_curcop)); + sv_setiv(sv, i); return 0; } } @@ -2123,7 +2123,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) } len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv); - pos = SvIV(sv) - CopARYBASE_get(PL_curcop); + pos = SvIV(sv); if (DO_UTF8(lsv)) { ulen = sv_len_utf8(lsv); @@ -2728,7 +2728,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } break; case '[': - CopARYBASE_set(&PL_compiling, SvIV(sv)); + if (SvIV(sv) != 0) + Perl_croak(aTHX_ "Assigning non-zero to $[ is no longer possible"); break; case '?': #ifdef COMPLEX_STATUS @@ -1170,8 +1170,6 @@ Perl_scalarvoid(pTHX_ OP *o) } else useless = "a constant (undef)"; - if (o->op_private & OPpCONST_ARYBASE) - useless = NULL; /* don't warn on optimised away booleans, eg * use constant Foo, 5; Foo || print; */ if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT) @@ -1732,24 +1730,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) localize = 0; PL_modcount++; return o; - case OP_CONST: - if (!(o->op_private & OPpCONST_ARYBASE)) - goto nomod; - localize = 0; - if (PL_eval_start && PL_eval_start->op_type == OP_CONST) { - CopARYBASE_set(&PL_compiling, - (I32)SvIV(cSVOPx(PL_eval_start)->op_sv)); - PL_eval_start = 0; - } - else if (!type) { - SAVECOPARYBASE(&PL_compiling); - CopARYBASE_set(&PL_compiling, 0); - } - else if (type == OP_REFGEN) - goto nomod; - else - Perl_croak(aTHX_ "That use of $[ is unsupported"); - break; case OP_STUB: if ((o->op_flags & OPf_PARENS) || PL_madskills) break; @@ -5015,18 +4995,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) bool maybe_common_vars = TRUE; PL_modcount = 0; - /* Grandfathering $[ assignment here. Bletch.*/ - /* Only simple assignments like C<< ($[) = 1 >> are allowed */ - PL_eval_start = (left->op_type == OP_CONST) ? right : NULL; left = op_lvalue(left, OP_AASSIGN); - if (PL_eval_start) - PL_eval_start = 0; - else if (left->op_type == OP_CONST) { - deprecate("assignment to $["); - /* FIXME for MAD */ - /* Result of assignment is always 1 (or we'd be dead already) */ - return newSVOP(OP_CONST, 0, newSViv(1)); - } curop = list(force_list(left)); o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop); o->op_private = (U8)(0 | (flags >> 8)); @@ -5168,19 +5137,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) scalar(right)); } else { - PL_eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/ o = newBINOP(OP_SASSIGN, flags, scalar(right), op_lvalue(scalar(left), OP_SASSIGN) ); - if (PL_eval_start) - PL_eval_start = 0; - else { - if (!PL_madskills) { /* assignment to $[ is ignored when making a mad dump */ - deprecate("assignment to $["); - op_free(o); - o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling))); - o->op_private |= OPpCONST_ARYBASE; - } - } } return o; } @@ -5228,9 +5186,6 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) cop->op_next = (OP*)cop; cop->cop_seq = seq; - /* CopARYBASE is now "virtual", in that it's stored as a flag bit in - CopHINTS and a possible value in cop_hints_hash, so no need to copy it. - */ cop->cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings); CopHINTHASH_set(cop, cophh_copy(CopHINTHASH_get(PL_curcop))); if (label) { @@ -9879,9 +9834,7 @@ Perl_rpeep(pTHX_ register OP *o) pop->op_next->op_type == OP_AELEM && !(pop->op_next->op_private & (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) && - (i = SvIV(((SVOP*)pop)->op_sv) - CopARYBASE_get(PL_curcop)) - <= 255 && - i >= 0) + (i = SvIV(((SVOP*)pop)->op_sv)) <= 255 && i >= 0) { GV *gv; if (cSVOPx(pop)->op_private & OPpCONST_STRICT) @@ -244,7 +244,6 @@ Deprecated. Use C<GIMME_V> instead. #define OPpCONST_SHORTCIRCUIT 4 /* eg the constant 5 in (5 || foo) */ #define OPpCONST_STRICT 8 /* bareword subject to strict 'subs' */ #define OPpCONST_ENTERED 16 /* Has been entered as symbol. */ -#define OPpCONST_ARYBASE 32 /* Was a $[ translated to constant. */ #define OPpCONST_BARE 64 /* Was a bare word (filehandle?). */ #define OPpCONST_WARNING 128 /* Was a $^W translated to constant. */ @@ -4822,7 +4822,6 @@ typedef enum { #define HINT_STRICT_REFS 0x00000002 /* strict pragma */ #define HINT_LOCALE 0x00000004 /* locale pragma */ #define HINT_BYTES 0x00000008 /* bytes pragma */ -#define HINT_ARYBASE 0x00000010 /* $[ is non-zero */ /* Note: 20,40,80 used for NATIVE_HINTS */ /* currently defined by vms/vmsish.h */ diff --git a/pod/perldata.pod b/pod/perldata.pod index f34979cef1..6d0fa0b21f 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -251,14 +251,6 @@ which return whatever they feel like returning.) The following is always true: X<array, length> - scalar(@whatever) == $#whatever - $[ + 1; - -Version 5 of Perl changed the semantics of C<$[>: files that don't set -the value of C<$[> no longer need to worry about whether another -file changed its value. (In other words, use of C<$[> is deprecated.) -So in general you can assume that -X<$[> - scalar(@whatever) == $#whatever + 1; Some programmers choose to use an explicit conversion so as to diff --git a/pod/perldelta.pod b/pod/perldelta.pod index bd03c83b39..b44c8440b6 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -60,6 +60,16 @@ pointers to null. Bug reported by Clément Lecigne. =head1 Incompatible Changes +=head2 $[ has been removed + +The array/string index offsetting mechanism, controlled by the C<$[> magic +variable, has been removed. C<$[> now always reads as zero. Writing a +zero to it is still permitted, but writing a non-zero value causes an +exception. Those hopelessly addicted to FORTRAN-style 1-based indexing +may wish to use the module L<Array::Base>, which provides an independent +implementation of the index offsetting concept, or L<Classic::Perl>, +which allows L<Array::Base> to be controlled through assignment to C<$[>. + =head2 User-defined case changing operations. This feature was deprecated in Perl 5.14, and has now been removed. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index d4373d6b3a..9ef46e4e36 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -238,6 +238,11 @@ spots. This is now heavily deprecated. (P) A general assertion failed. The file in question must be examined. +=item Assigning non-zero to $[ is no longer possible + +(F) The special variable C<$[>, deprecated in older perls, is now a fixed +zero value, because the feature that it used to control has been removed. + =item Assignment to both a list and a scalar (F) If you assign to a conditional operator, the 2nd and 3rd arguments @@ -4504,21 +4509,6 @@ a dirhandle. Check your control flow. (W unopened) You tried to use the tell() function on a filehandle that was either never opened or has since been closed. -=item That use of $[ is unsupported - -(F) Assignment to C<$[> is now strictly circumscribed, and interpreted -as a compiler directive. You may say only one of - - $[ = 0; - $[ = 1; - ... - local $[ = 0; - local $[ = 1; - ... - -This is to prevent the problem of one module changing the array base out -from under another module inadvertently. See L<perlvar/$[>. - =item The crypt() function is unimplemented due to excessive paranoia (F) Configure couldn't find the crypt() function on your machine, @@ -5119,11 +5109,6 @@ you can write it as C<push(@tied_array,())> to avoid this warning. (F) The "use" keyword is recognized and executed at compile time, and returns no useful value. See L<perlmod>. -=item Use of assignment to $[ is deprecated - -(D deprecated) The C<$[> variable (index of the first element in an array) -is deprecated. See L<perlvar/"$[">. - =item Use of bare << to mean <<"" is deprecated (D deprecated) You are now encouraged to use the explicitly quoted diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 7799fe4606..981032be05 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2683,9 +2683,8 @@ It returns the position of the first occurrence of SUBSTR in STR at or after POSITION. If POSITION is omitted, starts searching from the beginning of the string. POSITION before the beginning of the string or after its end is treated as if it were the beginning or the end, -respectively. POSITION and the return value are based at C<0> (or whatever -you've set the C<$[> variable to--but don't do that). If the substring -is not found, C<index> returns one less than the base, ordinarily C<-1>. +respectively. POSITION and the return value are based at zero. +If the substring is not found, C<index> returns -1. =item int EXPR X<int> X<integer> X<truncate> X<trunc> X<floor> @@ -6059,7 +6058,7 @@ If both OFFSET and LENGTH are omitted, removes everything. If OFFSET is past the end of the array, Perl issues a warning, and splices at the end of the array. -The following equivalences hold (assuming C<< $[ == 0 and $#a >= $i >> ) +The following equivalences hold (assuming C<< $#a >= $i >> ) push(@a,$x,$y) splice(@a,@a,0,$x,$y) pop(@a) splice(@a,-1) @@ -6866,8 +6865,7 @@ X<substr> X<substring> X<mid> X<left> X<right> =item substr EXPR,OFFSET Extracts a substring out of EXPR and returns it. First character is at -offset C<0> (or whatever you've set C<$[> to (but B<don't do that>)). -If OFFSET is negative (or more precisely, less than C<$[>), starts +offset zero. If OFFSET is negative, starts that far back from the end of the string. If LENGTH is omitted, returns everything through the end of the string. If LENGTH is negative, leaves that many characters off the end of the string. diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 890909d526..3217e3cc55 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -2071,25 +2071,17 @@ Removed in Perl 5.10. =item $[ X<$[> X<$ARRAY_BASE> -This variable stores the index of the first element in an array, and -of the first character in a substring. The default is 0, but you could -theoretically set it to 1 to make Perl behave more like B<awk> (or Fortran) -when subscripting and when evaluating the index() and substr() functions. - -As of release 5 of Perl, assignment to C<$[> is treated as a compiler -directive, and cannot influence the behavior of any other file. -(That's why you can only assign compile-time constants to it.) -Its use is highly discouraged. - -Prior to Perl 5.10, assignment to C<$[> could be seen from outer lexical -scopes in the same file, unlike other compile-time directives (such as -L<strict>). Using local() on it would bind its value strictly to a lexical -block. Now it is always lexically scoped. - -Mnemonic: [ begins subscripts. +C<$[> was a variable that you could use to offset the indexing of arrays +and strings. After a deprecation cycle, the feature was removed in +Perl 5.16. Two old ways of coping with the variability of the index +offset, which were rendered obsolete in Perl 5.000 when C<$[> became +effectively lexically scoped, are still supported: you can read it +(always yielding zero) and you can assign zero to it. Deprecated in Perl 5.12. +Removed in Perl 5.16. + =item $OLD_PERL_VERSION =item $] @@ -369,9 +369,7 @@ PP(pp_av2arylen) } SETs(*sv); } else { - SETs(sv_2mortal(newSViv( - AvFILL(MUTABLE_AV(av)) + CopARYBASE_get(PL_curcop) - ))); + SETs(sv_2mortal(newSViv(AvFILL(MUTABLE_AV(av))))); } RETURN; } @@ -396,7 +394,7 @@ PP(pp_pos) I32 i = mg->mg_len; if (DO_UTF8(sv)) sv_pos_b2u(sv, &i); - PUSHi(i + CopARYBASE_get(PL_curcop)); + PUSHi(i); RETURN; } } @@ -3006,7 +3004,6 @@ PP(pp_substr) int len_is_uv = 1; const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; const char *tmps; - const IV arybase = CopARYBASE_get(PL_curcop); SV *repl_sv = NULL; const char *repl = NULL; STRLEN repl_len; @@ -3052,32 +3049,12 @@ PP(pp_substr) else utf8_curlen = 0; - if ( (pos1_is_uv && arybase < 0) || (pos1_iv >= arybase) ) { /* pos >= $[ */ - UV pos1_uv = pos1_iv-arybase; - /* Overflow can occur when $[ < 0 */ - if (arybase < 0 && pos1_uv < (UV)pos1_iv) - goto bound_fail; - pos1_iv = pos1_uv; - pos1_is_uv = 1; - } - else if (pos1_is_uv ? (UV)pos1_iv > 0 : pos1_iv > 0) { - goto bound_fail; /* $[=3; substr($_,2,...) */ - } - else { /* pos < $[ */ - if (pos1_iv == 0) { /* $[=1; substr($_,0,...) */ - pos1_iv = curlen; - pos1_is_uv = 1; - } else { - if (curlen) { - pos1_is_uv = curlen-1 > ~(UV)pos1_iv; - pos1_iv += curlen; - } - } - } - if (pos1_is_uv || pos1_iv > 0) { - if ((UV)pos1_iv > curlen) - goto bound_fail; + if (!pos1_is_uv && pos1_iv < 0 && curlen) { + pos1_is_uv = curlen-1 > ~(UV)pos1_iv; + pos1_iv += curlen; } + if ((pos1_is_uv || pos1_iv > 0) && (UV)pos1_iv > curlen) + goto bound_fail; if (num_args > 2) { if (!len_is_uv && len_iv < 0) { @@ -3234,17 +3211,13 @@ PP(pp_index) I32 retval; const char *big_p; const char *little_p; - const I32 arybase = CopARYBASE_get(PL_curcop); bool big_utf8; bool little_utf8; const bool is_index = PL_op->op_type == OP_INDEX; const bool threeargs = MAXARG >= 3 && (TOPs || ((void)POPs,0)); - if (threeargs) { - /* arybase is in characters, like offset, so combine prior to the - UTF-8 to bytes calculation. */ - offset = POPi - arybase; - } + if (threeargs) + offset = POPi; little = POPs; big = POPs; big_p = SvPV_const(big, biglen); @@ -3339,7 +3312,7 @@ PP(pp_index) } SvREFCNT_dec(temp); fail: - PUSHi(retval + arybase); + PUSHi(retval); RETURN; } @@ -4378,7 +4351,6 @@ PP(pp_aslice) register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); if (SvTYPE(av) == SVt_PVAV) { - const I32 arybase = CopARYBASE_get(PL_curcop); const bool localizing = PL_op->op_private & OPpLVAL_INTRO; bool can_preserve = FALSE; @@ -4406,8 +4378,6 @@ PP(pp_aslice) I32 elem = SvIV(*MARK); bool preeminent = TRUE; - if (elem > 0) - elem -= arybase; if (localizing && can_preserve) { /* If we can determine whether the element exist, * Try to preserve the existenceness of a tied array @@ -4493,7 +4463,7 @@ PP(pp_aeach) } EXTEND(SP, 2); - mPUSHi(CopARYBASE_get(PL_curcop) + current); + mPUSHi(current); if (gimme == G_ARRAY) { SV **const element = av_fetch(array, current, 0); PUSHs(element ? *element : &PL_sv_undef); @@ -4516,13 +4486,12 @@ PP(pp_akeys) } else if (gimme == G_ARRAY) { IV n = Perl_av_len(aTHX_ array); - IV i = CopARYBASE_get(PL_curcop); + IV i; EXTEND(SP, n + 1); if (PL_op->op_type == OP_AKEYS || PL_op->op_type == OP_RKEYS) { - n += i; - for (; i <= n; i++) { + for (i = 0; i <= n; i++) { mPUSHi(i); } } @@ -4928,7 +4897,6 @@ PP(pp_lslice) SV ** const lastlelem = PL_stack_base + POPMARK; SV ** const firstlelem = PL_stack_base + POPMARK + 1; register SV ** const firstrelem = lastlelem + 1; - const I32 arybase = CopARYBASE_get(PL_curcop); I32 is_something_there = FALSE; register const I32 max = lastrelem - lastlelem; @@ -4938,8 +4906,6 @@ PP(pp_lslice) I32 ix = SvIV(*lastlelem); if (ix < 0) ix += max; - else - ix -= arybase; if (ix < 0 || ix >= max) *firstlelem = &PL_sv_undef; else @@ -4957,8 +4923,6 @@ PP(pp_lslice) I32 ix = SvIV(*lelem); if (ix < 0) ix += max; - else - ix -= arybase; if (ix < 0 || ix >= max) *lelem = &PL_sv_undef; else { @@ -5062,8 +5026,6 @@ PP(pp_splice) offset = i = SvIV(*MARK); if (offset < 0) offset += AvFILLp(ary) + 1; - else - offset -= CopARYBASE_get(PL_curcop); if (offset < 0) DIE(aTHX_ PL_no_aelem, i); if (++MARK < SP) { @@ -3508,7 +3508,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) PL_eval_root = NULL; PL_curcop = &PL_compiling; - CopARYBASE_set(PL_curcop, 0); if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL)) PL_in_eval |= EVAL_KEEPERR; else @@ -2800,8 +2800,6 @@ PP(pp_aelem) Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", SVfARG(elemsv)); - if (elem > 0) - elem -= CopARYBASE_get(PL_curcop); if (SvTYPE(av) != SVt_PVAV) RETPUSHUNDEF; @@ -1115,11 +1115,6 @@ Perl_leave_scope(pTHX_ I32 base) ptr = SSPOPPTR; (*SSPOPDPTR)(ptr); break; - case SAVEt_COP_ARYBASE: - ptr = SSPOPPTR; - i = SSPOPINT; - CopARYBASE_set((COP *)ptr, i); - break; case SAVEt_COMPILE_WARNINGS: ptr = SSPOPPTR; @@ -49,7 +49,6 @@ #define SAVEt_BOOL 38 #define SAVEt_SET_SVFLAGS 39 #define SAVEt_SAVESWITCHSTACK 40 -#define SAVEt_COP_ARYBASE 41 #define SAVEt_RE_STATE 42 #define SAVEt_COMPILE_WARNINGS 43 #define SAVEt_STACK_CXPOS 44 @@ -218,8 +217,6 @@ scope has the given name. Name must be a literal string. PL_curstackinfo->si_stack = (t); \ } STMT_END -#define SAVECOPARYBASE(c) save_pushi32ptr(CopARYBASE_get(c), c, SAVEt_COP_ARYBASE); - /* Need to do the cop warnings like this, rather than a "SAVEFREESHAREDPV", because realloc() means that the value can actually change. Possibly could have done savefreesharedpvREF, but this way actually seems cleaner, @@ -12339,7 +12339,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) TOPLONG(nss,ix) = longval; break; case SAVEt_I32: /* I32 reference */ - case SAVEt_COP_ARYBASE: /* call CopARYBASE_set */ ptr = POPPTR(ss,ix); TOPPTR(nss,ix) = any_dup(ptr, proto_perl); i = POPINT(ss,ix); diff --git a/t/lib/warnings/op b/t/lib/warnings/op index b3cb7d6bed..a6876866d2 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -520,7 +520,6 @@ use constant U => undef; U; 5 || print "bad\n"; # test OPpCONST_SHORTCIRCUIT print "boo\n" if U; # test OPpCONST_SHORTCIRCUIT -$[ = 2; # should not warn no warnings 'void' ; "abc"; # OP_CONST 7 ; # OP_CONST @@ -1005,7 +1004,6 @@ local(pos($x)); # OP_POS local(vec($x,0,1)); # OP_VEC local($a[$b]); # OP_AELEM ok local($a{$b}); # OP_HELEM ok -local($[); # OP_CONST no warnings 'syntax'; EXPECT @@ -1063,21 +1061,6 @@ Deprecated use of my() in false conditional at - line 7. Deprecated use of my() in false conditional at - line 8. ######## # op.c -$[ = 1; -($[) = 1; -use warnings 'deprecated'; -$[ = 2; -($[) = 2; -no warnings 'deprecated'; -$[ = 3; -($[) = 3; -EXPECT -Use of assignment to $[ is deprecated at - line 2. -Use of assignment to $[ is deprecated at - line 3. -Use of assignment to $[ is deprecated at - line 5. -Use of assignment to $[ is deprecated at - line 6. -######## -# op.c use warnings 'void'; @x = split /y/, "z"; $x = split /y/, "z"; diff --git a/t/op/array.t b/t/op/array.t index aec4b30167..b53da80424 100644 --- a/t/op/array.t +++ b/t/op/array.t @@ -7,7 +7,7 @@ BEGIN { require 'test.pl'; -plan (131); +plan (123); # # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them @@ -24,23 +24,6 @@ is(join('',@ary), '1234'); { no warnings 'deprecated'; -$[ = 1; -@ary = (1,2,3,4,5); -is(join('',@ary), '12345'); - -$tmp = $ary[$#ary]; --$#ary; -is($tmp, 5); -# Must do == here beacuse $[ isn't 0 -ok($#ary == 4); -is(join('',@ary), '1234'); - -is($ary[5], undef); - -$#ary += 1; # see if element 5 gone for good -ok($#ary == 5); -ok(!defined $ary[5]); - -$[ = 0; @foo = (); $r = join(',', $#foo, @foo); is($r, "-1"); @@ -254,22 +237,6 @@ sub foo { "a" } @foo=(foo())[0,0]; is ($foo[1], "a"); -# $[ should have the same effect regardless of whether the aelem -# op is optimized to aelemfast. - - - -sub tary { - no warnings 'deprecated'; - local $[ = 10; - my $five = 5; - is ($tary[5], $tary[$five]); -} - -@tary = (0..50); -tary(); - - # bugid #15439 - clearing an array calls destructors which may try # to modify the array - caused 'Attempt to free unreferenced scalar' diff --git a/t/op/array_base.aux b/t/op/array_base.aux deleted file mode 100644 index 79b6deed8c..0000000000 --- a/t/op/array_base.aux +++ /dev/null @@ -1,5 +0,0 @@ -our($ra1, $ri1, $rf1, $rfe1); -$ra1 = $[; -BEGIN { $ri1 = $^H; $rf1 = $^H{foo}; $rfe1 = exists($^H{foo}); } - -1; diff --git a/t/op/array_base.t b/t/op/array_base.t index 3cc9b2425c..369cf31614 100644 --- a/t/op/array_base.t +++ b/t/op/array_base.t @@ -3,80 +3,11 @@ use strict; require './test.pl'; -plan (tests => 24); -no warnings 'deprecated'; +plan (tests => 4); -# Bug #27024 -{ - # this used to segfault (because $[=1 is optimized away to a null block) - my $x; - $[ = 1 while $x; - pass('#27204'); - $[ = 0; # restore the original value for less side-effects -} +is(eval('$['), 0); +is(eval('$[ = 0; 123'), 123); +is(eval('$[ = 1; 123'), undef); +like($@, qr/\AAssigning non-zero to \$\[ is no longer possible/); -# [perl #36313] perl -e "1for$[=0" crash -{ - my $x; - $x = 1 for ($[) = 0; - pass('optimized assignment to $[ used to segfault in list context'); - if ($[ = 0) { $x = 1 } - pass('optimized assignment to $[ used to segfault in scalar context'); - $x = ($[=2.4); - is($x, 2, 'scalar assignment to $[ behaves like other variables'); - $x = (($[) = 0); - is($x, 1, 'list assignment to $[ behaves like other variables'); - $x = eval q{ ($[, $x) = (0) }; - like($@, qr/That use of \$\[ is unsupported/, - 'cannot assign to $[ in a list'); - eval q{ ($[) = (0, 1) }; - like($@, qr/That use of \$\[ is unsupported/, - 'cannot assign list of >1 elements to $['); - eval q{ ($[) = () }; - like($@, qr/That use of \$\[ is unsupported/, - 'cannot assign list of <1 elements to $['); -} - - -{ - $[ = 11; - cmp_ok($[ + 0, '==', 11, 'setting $[ affects $['); - our $t11; BEGIN { $t11 = $^H{'$['} } - cmp_ok($t11, '==', 11, 'setting $[ affects $^H{\'$[\'}'); - - BEGIN { $^H{'$['} = 22 } - cmp_ok($[ + 0, '==', 22, 'setting $^H{\'$\'} affects $['); - our $t22; BEGIN { $t22 = $^H{'$['} } - cmp_ok($t22, '==', 22, 'setting $^H{\'$[\'} affects $^H{\'$[\'}'); - - BEGIN { %^H = () } - my $val = do { - no warnings 'uninitialized'; - $[; - }; - cmp_ok($val, '==', 0, 'clearing %^H affects $['); - our $t0; BEGIN { $t0 = $^H{'$['} } - cmp_ok($t0, '==', 0, 'clearing %^H affects $^H{\'$[\'}'); -} - -{ - $[ = 13; - BEGIN { $^H |= 0x04000000; $^H{foo} = "z"; } - - our($ri0, $rf0); BEGIN { $ri0 = $^H; $rf0 = $^H{foo}; } - cmp_ok($[ + 0, '==', 13, '$[ correct before require'); - ok($ri0 & 0x04000000, '$^H correct before require'); - is($rf0, "z", '$^H{foo} correct before require'); - - our($ra1, $ri1, $rf1, $rfe1); - BEGIN { require "op/array_base.aux"; } - cmp_ok($ra1, '==', 0, '$[ cleared for require'); - ok(!($ri1 & 0x04000000), '$^H cleared for require'); - is($rf1, undef, '$^H{foo} cleared for require'); - ok(!$rfe1, '$^H{foo} cleared for require'); - - our($ri2, $rf2); BEGIN { $ri2 = $^H; $rf2 = $^H{foo}; } - cmp_ok($[ + 0, '==', 13, '$[ correct after require'); - ok($ri2 & 0x04000000, '$^H correct after require'); - is($rf2, "z", '$^H{foo} correct after require'); -} +1; diff --git a/t/op/each_array.t b/t/op/each_array.t index 9a6073ab75..60528053bf 100644 --- a/t/op/each_array.t +++ b/t/op/each_array.t @@ -10,7 +10,7 @@ use warnings; no warnings 'deprecated'; use vars qw(@array @r $k $v $c); -plan tests => 66; +plan tests => 57; @array = qw(crunch zam bloop); @@ -33,16 +33,8 @@ is ($r[0], 0); is ($r[1], 'crunch'); ($k) = each @array; is ($k, 1); -{ - $[ = 2; - my ($k, $v) = each @array; - is ($k, 4); - is ($v, 'bloop'); - (@r) = each @array; - is (scalar @r, 0); -} -my @lex_array = qw(PLOP SKLIZZORCH RATTLE PBLRBLPSFT); +my @lex_array = qw(PLOP SKLIZZORCH RATTLE); (@r) = each @lex_array; is (scalar @r, 2); @@ -53,12 +45,6 @@ is ($k, 1); is ($v, 'SKLIZZORCH'); ($k) = each @lex_array; is ($k, 2); -{ - $[ = -42; - my ($k, $v) = each @lex_array; - is ($k, -39); - is ($v, 'PBLRBLPSFT'); -} (@r) = each @lex_array; is (scalar @r, 0); @@ -80,17 +66,7 @@ my @keys; is ("@keys", "0 1 2"); @keys = keys @lex_array; -is ("@keys", "0 1 2 3"); - -{ - $[ = 1; - - @keys = keys @array; - is ("@keys", "1 2 3"); - - @keys = keys @lex_array; - is ("@keys", "1 2 3 4"); -} +is ("@keys", "0 1 2"); ($k, $v) = each @array; is ($k, 0); @@ -112,16 +88,6 @@ is ("@values", "@array"); @values = values @lex_array; is ("@values", "@lex_array"); -{ - $[ = 1; - - @values = values @array; - is ("@values", "@array"); - - @values = values @lex_array; - is ("@values", "@lex_array"); -} - ($k, $v) = each @array; is ($k, 0); is ($v, 'crunch'); @@ -134,7 +100,6 @@ is ($k, 0); is ($v, 'crunch'); # reset -$[ = 0; while (each @array) { } # each(ARRAY) in the conditional loop @@ -147,7 +112,7 @@ while (($k, $v) = each @array) { # each(ARRAY) on scalar context in conditional loop # should guarantee to be wrapped into defined() function. -# first return value will be $[ --> [#90888] +# first return value will be 0 --> [#90888] $c = 0; $k = 0; $v = 0; diff --git a/t/op/index.t b/t/op/index.t index b5b1005e6c..de742a0e6d 100644 --- a/t/op/index.t +++ b/t/op/index.t @@ -7,7 +7,7 @@ BEGIN { } use strict; -plan( tests => 122 ); +plan( tests => 114 ); run_tests() unless caller; @@ -128,19 +128,6 @@ is(rindex($a, "foo", ), 0); is (rindex($text, $search_octets), -1); } -foreach my $utf8 ('', ', utf-8') { - foreach my $arraybase (0, 1, -1, -2) { - my $expect_pos = 2 + $arraybase; - - my $prog = "no warnings 'deprecated';\n"; - $prog .= "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; "; - $prog .= '$big .= chr 256; chop $big; ' if $utf8; - $prog .= 'print rindex $big, "N", 2 + $['; - - fresh_perl_is($prog, $expect_pos, {}, "\$[ = $arraybase$utf8"); - } -} - SKIP: { skip "UTF-EBCDIC is limited to 0x7fffffff", 3 if ord("A") == 193; diff --git a/t/op/leaky-magic.t b/t/op/leaky-magic.t index 9e2d835a3d..371f3acbd6 100644 --- a/t/op/leaky-magic.t +++ b/t/op/leaky-magic.t @@ -104,11 +104,6 @@ for(qw< S V >) { ok eval { ${"foo::$name"} = 'twor'}, "\$foo::^$_"; } -use tests 1; # $[ -# To avoid tests that are *too* weird, we’ll just check for definition. -${"foo::["}; # touch -ok !defined ${"foo::["}, '$foo::['; - use tests 4; # user/group vars # These are rw, but setting them is obviously going to make the test much # more complex than necessary. So, again, we check for definition. diff --git a/t/op/local.t b/t/op/local.t index d93306f0b0..d7a29756df 100644 --- a/t/op/local.t +++ b/t/op/local.t @@ -5,7 +5,7 @@ BEGIN { @INC = qw(. ../lib); require './test.pl'; } -plan tests => 307; +plan tests => 305; my $list_assignment_supported = 1; @@ -666,16 +666,6 @@ is($@, ""); eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } }; is($@, ""); -# RT #4342 Special local() behavior for $[ -{ - no warnings 'deprecated'; - local $[ = 1; - ok(1 == $[, 'lexcical scope of local $['); - f(); -} - -sub f { ok(0 == $[); } - # sub localisation { package Other; diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index cc176c53c3..436c0329a3 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -201,6 +201,7 @@ pod/perldbmfilter.pod Verbatim line length including indents exceeds 79 by 1 pod/perldebguts.pod Verbatim line length including indents exceeds 79 by 68 pod/perldebtut.pod Verbatim line length including indents exceeds 79 by 22 pod/perldebug.pod Verbatim line length including indents exceeds 79 by 3 +pod/perldelta.pod Apparent broken link 3 pod/perldiag.pod =item type mismatch 1 pod/perldiag.pod Verbatim line length including indents exceeds 79 by 2 pod/perldsc.pod Verbatim line length including indents exceeds 79 by 4 diff --git a/t/re/substr.t b/t/re/substr.t index 341625619a..b48cb8f00c 100644 --- a/t/re/substr.t +++ b/t/re/substr.t @@ -24,7 +24,7 @@ $SIG{__WARN__} = sub { BEGIN { require './test.pl'; } -plan(363); +plan(356); run_tests() unless caller; @@ -44,20 +44,6 @@ like ($@, $FATAL_MSG); is(substr($a,0,-6), 'abc'); # P=Q R S is(substr($a,-3,1), 'x'); # P Q R S -$[ = 1; - -is(substr($a,1,3), 'abc' ); # P=Q R S -is(substr($a,4,3), 'def' ); # P Q R S -is(substr($a,7,999), 'xyz');# P Q S R -$b = substr($a,999,999) ; # warn # P R Q S -is($w--, 1); -eval{substr($a,999,999) = "" ; } ; # P R Q S -like ($@, $FATAL_MSG); -is(substr($a,1,-6), 'abc' );# P=Q R S -is(substr($a,-3,1), 'x' ); # P Q R S - -$[ = 0; - substr($a,3,3) = 'XYZ'; is($a, 'abcXYZxyz' ); substr($a,0,2) = ''; @@ -6023,14 +6023,6 @@ Perl_yylex(pTHX) PREREF('$'); } - /* This kludge not intended to be bulletproof. */ - if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) { - pl_yylval.opval = newSVOP(OP_CONST, 0, - newSViv(CopARYBASE_get(&PL_compiling))); - pl_yylval.opval->op_private = OPpCONST_ARYBASE; - TERM(THING); - } - d = s; { const char tmp = *s; |