Remove support for setting $[ to a non-zero value
authorDagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Wed, 18 Oct 2017 00:01:11 +0000 (01:01 +0100)
committerDagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Wed, 26 Sep 2018 12:00:19 +0000 (13:00 +0100)
This removes arybase and all its surrounding machinery.

38 files changed:
MANIFEST
Porting/Maintainers.pl
dist/Module-CoreList/lib/Module/CoreList.pm
ext/B/B.pm
ext/arybase/arybase.pm [deleted file]
ext/arybase/arybase.xs [deleted file]
ext/arybase/ptable.h [deleted file]
ext/arybase/t/aeach.t [deleted file]
ext/arybase/t/aelem.t [deleted file]
ext/arybase/t/akeys.t [deleted file]
ext/arybase/t/arybase.t [deleted file]
ext/arybase/t/aslice.t [deleted file]
ext/arybase/t/av2arylen.t [deleted file]
ext/arybase/t/index.t [deleted file]
ext/arybase/t/lslice.t [deleted file]
ext/arybase/t/pos.t [deleted file]
ext/arybase/t/scope.t [deleted file]
ext/arybase/t/scope_0.pm [deleted file]
ext/arybase/t/splice.t [deleted file]
ext/arybase/t/substr.t [deleted file]
feature.h
gv.c
lib/.gitignore
lib/feature.pm
op.c
pod/perldelta.pod
pod/perldeprecation.pod
pod/perldiag.pod
pod/perlvar.pod
regen/feature.pl
t/lib/feature/bundle
t/lib/feature/implicit
t/lib/feature/removed [new file with mode: 0644]
t/lib/warnings/op
t/op/array_base.t [deleted file]
t/op/magic.t
t/porting/known_pod_issues.dat
t/uni/variables.t

index 928eac3..bcfd99c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3910,22 +3910,6 @@ ext/Amiga-Exec/Exec.xs   Amiga::Exec extension
 ext/Amiga-Exec/Makefile.PL                     Amiga::Exec extension
 ext/Amiga-Exec/tagtypes.h      Amiga::Exec extension
 ext/Amiga-Exec/typemap         Amiga::Exec extension
-ext/arybase/arybase.pm         For $[
-ext/arybase/arybase.xs         For $[
-ext/arybase/ptable.h           For $[
-ext/arybase/t/aeach.t          For $[
-ext/arybase/t/aelem.t          For $[
-ext/arybase/t/akeys.t          For $[
-ext/arybase/t/arybase.t                For $[
-ext/arybase/t/aslice.t         For $[
-ext/arybase/t/av2arylen.t      For $[
-ext/arybase/t/index.t          For $[
-ext/arybase/t/lslice.t         For $[
-ext/arybase/t/pos.t            For $[
-ext/arybase/t/scope.t          For $[
-ext/arybase/t/scope_0.pm       For $[
-ext/arybase/t/splice.t         For $[
-ext/arybase/t/substr.t         For $[
 ext/attributes/attributes.pm           For "sub foo : attrlist"
 ext/attributes/attributes.xs           For "sub foo : attrlist"
 ext/B/B.pm             Compiler backend support functions and methods
@@ -5459,6 +5443,7 @@ t/lib/Devel/switchd_goto.pm       Module for t/run/switchd.t
 t/lib/feature/bundle           Tests for feature bundles
 t/lib/feature/implicit         Tests for implicit loading of feature.pm
 t/lib/feature/nonesuch         Tests for enabling/disabling nonexistent feature
+t/lib/feature/removed          Tests for enabling/disabling removed feature
 t/lib/feature/say              Tests for enabling/disabling say feature
 t/lib/feature/switch           Tests for enabling/disabling switch feature
 t/lib/h2ph.h                   Test header file for h2ph
@@ -5597,7 +5582,6 @@ 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/array.t                   See if array operations work
-t/op/array_base.t              Tests for the remnant of $[
 t/op/assignwarn.t              See if OP= operators warn correctly for undef targets
 t/op/attrhand.t                        See if attribute handlers work
 t/op/attrproto.t               See if the prototype attribute works
index 7e75d6a..6d8a900 100755 (executable)
@@ -1323,7 +1323,6 @@ use File::Glob qw(:case);
                 ext/Win32CORE/
                 ext/XS-APItest/
                 ext/XS-Typemap/
-                ext/arybase/
                 ext/attributes/
                 ext/mro/
                 ext/re/
index b533b23..fad2727 100644 (file)
@@ -16717,6 +16717,7 @@ sub is_core
         changed => {
         },
         removed => {
+            arybase => '1',
         }
     },
 );
index ce061e4..5ec8b8c 100644 (file)
@@ -20,7 +20,7 @@ sub import {
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.74';
+    $B::VERSION = '1.75';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
@@ -1194,8 +1194,6 @@ The C<B::COP> class is used for "nextstate" and "dbstate" ops.  As of Perl
 
 =item cop_seq
 
-=item arybase
-
 =item line
 
 =item warnings
diff --git a/ext/arybase/arybase.pm b/ext/arybase/arybase.pm
deleted file mode 100644 (file)
index 5e34e29..0000000
+++ /dev/null
@@ -1,98 +0,0 @@
-package arybase;
-
-our $VERSION = "0.15";
-
-require XSLoader;
-XSLoader::load(); # This returns true, which makes require happy.
-
-__END__
-
-=head1 NAME
-
-arybase - Set indexing base via $[
-
-=head1 SYNOPSIS
-
-    $[ = 1;
-
-    @a = qw(Sun Mon Tue Wed Thu Fri Sat);
-    print $a[3], "\n";  # prints Tue
-
-=head1 DESCRIPTION
-
-This module implements Perl's C<$[> variable.  You should not use it
-directly.
-
-Assigning to C<$[> has the I<compile-time> effect of making the assigned
-value, converted to an integer, the index of the first element in an array
-and the first character in a substring, within the enclosing lexical scope.
-
-It can be written with or without C<local>:
-
-    $[ = 1;
-    local $[ = 1;
-
-It only works if the assignment can be detected at compile time and the
-value assigned is constant.
-
-It affects the following operations:
-
-    $array[$element]
-    @array[@slice]
-    $#array
-    (list())[$slice]
-    splice @array, $index, ...
-    each @array
-    keys @array
-
-    index $string, $substring  # return value is affected
-    pos $string
-    substr $string, $offset, ...
-
-As with the default base of 0, negative bases count from the end of the
-array or string, starting with -1.  If C<$[> is a positive integer, indices
-from C<$[-1> to 0 also count from the end.  If C<$[> is negative (why would
-you do that, though?), indices from C<$[> to 0 count from the beginning of
-the string, but indices below C<$[> count from the end of the string as
-though the base were 0.
-
-Prior to Perl 5.16, indices from 0 to C<$[-1> inclusive, for positive
-values of C<$[>, behaved differently for different operations; negative
-indices equal to or greater than a negative C<$[> likewise behaved
-inconsistently.
-
-=head1 HISTORY
-
-Before Perl 5, C<$[> was a global variable that affected all array indices
-and string offsets.
-
-Starting with Perl 5, it became a file-scoped compile-time directive, which
-could be made lexically-scoped with C<local>.  "File-scoped" means that the
-C<$[> assignment could leak out of the block in which occurred:
-
-    {
-        $[ = 1;
-        # ... array base is 1 here ...
-    }
-    # ... still 1, but not in other files ...
-
-In Perl 5.10, it became strictly lexical.  The file-scoped behaviour was
-removed (perhaps inadvertently, but what's done is done).
-
-In Perl 5.16, the implementation was moved into this module, and out of the
-Perl core.  The erratic behaviour that occurred with indices between -1 and
-C<$[> was made consistent between operations, and, for negative bases,
-indices from C<$[> to -1 inclusive were made consistent between operations.
-
-=head1 BUGS
-
-Error messages that mention array indices use the 0-based index.
-
-C<keys $arrayref> and C<each $arrayref> do not respect the current value of
-C<$[>.
-
-=head1 SEE ALSO
-
-L<perlvar/"$[">, L<Array::Base> and L<String::Base>.
-
-=cut
diff --git a/ext/arybase/arybase.xs b/ext/arybase/arybase.xs
deleted file mode 100644 (file)
index 6c12d05..0000000
+++ /dev/null
@@ -1,496 +0,0 @@
-#define PERL_NO_GET_CONTEXT     /* we want efficiency */
-#define PERL_EXT
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "feature.h"
-
-/* ... op => info map ................................................. */
-
-typedef struct {
- OP *(*old_pp)(pTHX);
- IV base;
-} ab_op_info;
-
-#define PTABLE_NAME        ptable_map
-#define PTABLE_VAL_FREE(V) PerlMemShared_free(V)
-#include "ptable.h"
-#define ptable_map_store(T, K, V) ptable_map_store(aPTBLMS_ (T), (K), (V))
-
-STATIC ptable *ab_op_map = NULL;
-
-#ifdef USE_ITHREADS
-STATIC perl_mutex ab_op_map_mutex;
-#endif
-
-STATIC const ab_op_info *ab_map_fetch(const OP *o, ab_op_info *oi) {
- const ab_op_info *val;
-
- MUTEX_LOCK(&ab_op_map_mutex);
-
- val = (ab_op_info *)ptable_fetch(ab_op_map, o);
- if (val) {
-  *oi = *val;
-  val = oi;
- }
-
- MUTEX_UNLOCK(&ab_op_map_mutex);
-
- return val;
-}
-
-STATIC const ab_op_info *ab_map_store_locked(
- pPTBLMS_ const OP *o, OP *(*old_pp)(pTHX), IV base
-) {
-#define ab_map_store_locked(O, PP, B) \
-  ab_map_store_locked(aPTBLMS_ (O), (PP), (B))
- ab_op_info *oi;
-
- if (!(oi = (ab_op_info *)ptable_fetch(ab_op_map, o))) {
-  oi = (ab_op_info *)PerlMemShared_malloc(sizeof *oi);
-  ptable_map_store(ab_op_map, o, oi);
- }
-
- oi->old_pp = old_pp;
- oi->base   = base;
- return oi;
-}
-
-STATIC void ab_map_store(
- pPTBLMS_ const OP *o, OP *(*old_pp)(pTHX), IV base)
-{
-#define ab_map_store(O, PP, B) ab_map_store(aPTBLMS_ (O),(PP),(B))
-
- MUTEX_LOCK(&ab_op_map_mutex);
-
- ab_map_store_locked(o, old_pp, base);
-
- MUTEX_UNLOCK(&ab_op_map_mutex);
-}
-
-STATIC void ab_map_delete(pTHX_ const OP *o) {
-#define ab_map_delete(O) ab_map_delete(aTHX_ (O))
- MUTEX_LOCK(&ab_op_map_mutex);
-
- ptable_map_store(ab_op_map, o, NULL);
-
- MUTEX_UNLOCK(&ab_op_map_mutex);
-}
-
-/* ... $[ Implementation .............................................. */
-
-#define hintkey     "$["
-#define hintkey_len  (sizeof(hintkey)-1)
-
-STATIC SV * ab_hint(pTHX_ const bool create) {
-#define ab_hint(c) ab_hint(aTHX_ c)
- dVAR;
- SV **val
-  = hv_fetch(GvHV(PL_hintgv), hintkey, hintkey_len, create);
- if (!val)
-  return 0;
- return *val;
-}
-
-/* current base at compile time */
-STATIC IV current_base(pTHX) {
-#define current_base() current_base(aTHX)
- SV *hsv = ab_hint(0);
- assert(FEATURE_ARYBASE_IS_ENABLED);
- if (!hsv || !SvOK(hsv)) return 0;
- return SvIV(hsv);
-}
-
-STATIC void set_arybase_to(pTHX_ IV base) {
-#define set_arybase_to(base) set_arybase_to(aTHX_ (base))
- dVAR;
- SV *hsv = ab_hint(1);
- sv_setiv_mg(hsv, base);
-}
-
-#define old_ck(opname) STATIC OP *(*ab_old_ck_##opname)(pTHX_ OP *) = 0
-old_ck(sassign);
-old_ck(aassign);
-old_ck(aelem);
-old_ck(aslice);
-old_ck(lslice);
-old_ck(av2arylen);
-old_ck(splice);
-old_ck(keys);
-old_ck(each);
-old_ck(substr);
-old_ck(rindex);
-old_ck(index);
-old_ck(pos);
-
-STATIC bool ab_op_is_dollar_bracket(pTHX_ OP *o) {
-#define ab_op_is_dollar_bracket(o) ab_op_is_dollar_bracket(aTHX_ (o))
- OP *c;
- return o->op_type == OP_RV2SV && (o->op_flags & OPf_KIDS)
-  && (c = cUNOPx(o)->op_first)
-  && c->op_type == OP_GV
-  && GvSTASH(cGVOPx_gv(c)) == PL_defstash
-  && strEQ(GvNAME(cGVOPx_gv(c)), "[");
-}
-
-STATIC void ab_neuter_dollar_bracket(pTHX_ OP *o) {
-#define ab_neuter_dollar_bracket(o) ab_neuter_dollar_bracket(aTHX_ (o))
- OP *oldc, *newc;
- /*
-  * Must replace the core's $[ with something that can accept assignment
-  * of non-zero value and can be local()ised.  Simplest thing is a
-  * different global variable.
-  */
- oldc = cUNOPx(o)->op_first;
- newc = newGVOP(OP_GV, 0,
-   gv_fetchpvs("arybase::leftbrack", GV_ADDMULTI, SVt_PVGV));
- /* replace oldc with newc */
- op_sibling_splice(o, NULL, 1, newc);
- op_free(oldc);
-}
-
-STATIC void ab_process_assignment(pTHX_ OP *left, OP *right) {
-#define ab_process_assignment(l, r) \
-    ab_process_assignment(aTHX_ (l), (r))
- if (ab_op_is_dollar_bracket(left) && right->op_type == OP_CONST) {
-  IV base = SvIV(cSVOPx_sv(right));
-  set_arybase_to(base);
-  ab_neuter_dollar_bracket(left);
-  if (base) {
-    Perl_ck_warner_d(aTHX_
-     packWARN(WARN_DEPRECATED), "Use of assignment to $[ is deprecated"
-                                ", and will be fatal in Perl 5.30"
-    );
-  }
- }
-}
-
-STATIC OP *ab_ck_sassign(pTHX_ OP *o) {
- o = (*ab_old_ck_sassign)(aTHX_ o);
- if (o->op_type == OP_SASSIGN && FEATURE_ARYBASE_IS_ENABLED) {
-  OP *right = cBINOPx(o)->op_first;
-  OP *left = OpSIBLING(right);
-  if (left) ab_process_assignment(left, right);
- }
- return o;
-}
-
-STATIC OP *ab_ck_aassign(pTHX_ OP *o) {
- o = (*ab_old_ck_aassign)(aTHX_ o);
- if (o->op_type == OP_AASSIGN && FEATURE_ARYBASE_IS_ENABLED) {
-  OP *right = cBINOPx(o)->op_first;
-  OP *left = OpSIBLING(right);
-  left = OpSIBLING(cBINOPx(left)->op_first);
-  right = OpSIBLING(cBINOPx(right)->op_first);
-  ab_process_assignment(left, right);
- }
- return o;
-}
-
-STATIC void
-tie(pTHX_ SV * const sv, SV * const obj, HV *const stash)
-{
-    SV *rv = newSV_type(SVt_RV);
-
-    SvRV_set(rv, obj ? SvREFCNT_inc_simple_NN(obj) : newSV(0));
-    SvROK_on(rv);
-    sv_bless(rv, stash);
-
-    sv_unmagic((SV *)sv, PERL_MAGIC_tiedscalar);
-    sv_magic((SV *)sv, rv, PERL_MAGIC_tiedscalar, NULL, 0);
-    SvREFCNT_dec(rv); /* As sv_magic increased it by one.  */
-}
-
-/* This function converts from base-based to 0-based an index to be passed
-   as an argument. */
-static IV
-adjust_index(IV index, IV base)
-{
- if (index >= base || index > -1) return index-base;
- return index;
-}
-/* This function converts from 0-based to base-based an index to
-   be returned. */
-static IV
-adjust_index_r(IV index, IV base)
-{
- return index + base;
-}
-
-#define replace_sv(sv,base) \
- ((sv) = sv_2mortal(newSViv(adjust_index(SvIV(sv),base))))
-#define replace_sv_r(sv,base) \
- ((sv) = sv_2mortal(newSViv(adjust_index_r(SvIV(sv),base))))
-
-static OP *ab_pp_basearg(pTHX) {
- dVAR; dSP;
- SV **firstp = NULL;
- SV **svp;
- UV count = 1;
- ab_op_info oi;
- Zero(&oi, 1, ab_op_info);
- ab_map_fetch(PL_op, &oi);
- switch (PL_op->op_type) {
- case OP_AELEM:
-  firstp = SP;
-  break;
- case OP_ASLICE:
-  firstp = PL_stack_base + TOPMARK + 1;
-  count = SP-firstp;
-  break;
- case OP_LSLICE:
-  firstp = PL_stack_base + *(PL_markstack_ptr-1)+1;
-  count = TOPMARK - *(PL_markstack_ptr-1);
-  if (GIMME_V != G_ARRAY) {
-   firstp += count-1;
-   count = 1;
-  }
-  break;
- case OP_SPLICE:
-  if (SP - PL_stack_base - TOPMARK >= 2)
-   firstp = PL_stack_base + TOPMARK + 2;
-  else count = 0;
-  break;
- case OP_SUBSTR:
-  firstp = SP-(PL_op->op_private & 7)+2;
-  break;
- default:
-  DIE(aTHX_
-     "panic: invalid op type for arybase.xs:ab_pp_basearg: %d",
-      PL_op->op_type);
- }
- svp = firstp;
- while (count--) replace_sv(*svp,oi.base), svp++;
- return (*oi.old_pp)(aTHX);
-}
-
-static OP *ab_pp_av2arylen(pTHX) {
- dSP; dVAR;
- SV *sv;
- ab_op_info oi;
- OP *ret;
- Zero(&oi, 1, ab_op_info);
- ab_map_fetch(PL_op, &oi);
- ret = (*oi.old_pp)(aTHX);
- if (PL_op->op_flags & OPf_MOD || LVRET) {
-  sv = newSV(0);
-  tie(aTHX_ sv, TOPs, gv_stashpv("arybase::mg",1));
-  SETs(sv);
- }
- else {
-  SvGETMAGIC(TOPs);
-  if (SvOK(TOPs)) replace_sv_r(TOPs, oi.base);
- }
- return ret;
-}
-
-static OP *ab_pp_keys(pTHX) {
- dVAR; dSP;
- ab_op_info oi;
- OP *retval;
- const I32 offset = SP - PL_stack_base;
- SV **svp;
- Zero(&oi, 1, ab_op_info);
- ab_map_fetch(PL_op, &oi);
- retval = (*oi.old_pp)(aTHX);
- if (GIMME_V == G_SCALAR) return retval;
- SPAGAIN;
- svp = PL_stack_base + offset;
- while (svp <= SP) replace_sv_r(*svp,oi.base), ++svp;
- return retval; 
-}
-
-static OP *ab_pp_each(pTHX) {
- dVAR; dSP;
- ab_op_info oi;
- OP *retval;
- const I32 offset = SP - PL_stack_base;
- Zero(&oi, 1, ab_op_info);
- ab_map_fetch(PL_op, &oi);
- retval = (*oi.old_pp)(aTHX);
- SPAGAIN;
- if (GIMME_V == G_SCALAR) {
-  if (SvOK(TOPs)) replace_sv_r(TOPs,oi.base);
- }
- else if (offset < SP - PL_stack_base) replace_sv_r(TOPm1s,oi.base);
- return retval; 
-}
-
-static OP *ab_pp_index(pTHX) {
- dVAR; dSP;
- ab_op_info oi;
- OP *retval;
- Zero(&oi, 1, ab_op_info);
- ab_map_fetch(PL_op, &oi);
- if (MAXARG == 3 && TOPs) replace_sv(TOPs,oi.base);
- retval = (*oi.old_pp)(aTHX);
- SPAGAIN;
- replace_sv_r(TOPs,oi.base);
- return retval; 
-}
-
-static OP *ab_ck_base(pTHX_ OP *o)
-{
- OP * (*old_ck)(pTHX_ OP *o) = 0;
- OP * (*new_pp)(pTHX)        = ab_pp_basearg;
- switch (o->op_type) {
- case OP_AELEM    : old_ck = ab_old_ck_aelem    ; break;
- case OP_ASLICE   : old_ck = ab_old_ck_aslice   ; break;
- case OP_LSLICE   : old_ck = ab_old_ck_lslice   ; break;
- case OP_AV2ARYLEN: old_ck = ab_old_ck_av2arylen; break;
- case OP_SPLICE   : old_ck = ab_old_ck_splice   ; break;
- case OP_KEYS     : old_ck = ab_old_ck_keys     ; break;
- case OP_EACH     : old_ck = ab_old_ck_each     ; break;
- case OP_SUBSTR   : old_ck = ab_old_ck_substr   ; break;
- case OP_RINDEX   : old_ck = ab_old_ck_rindex   ; break;
- case OP_INDEX    : old_ck = ab_old_ck_index    ; break;
- case OP_POS      : old_ck = ab_old_ck_pos      ; break;
- default:
-  DIE(aTHX_
-     "panic: invalid op type for arybase.xs:ab_ck_base: %d",
-      PL_op->op_type);
- }
- o = (*old_ck)(aTHX_ o);
- if (!FEATURE_ARYBASE_IS_ENABLED) return o;
- /* We need two switch blocks, as the type may have changed. */
- switch (o->op_type) {
- case OP_AELEM    :
- case OP_ASLICE   :
- case OP_LSLICE   :
- case OP_SPLICE   :
- case OP_SUBSTR   : break;
- case OP_POS      :
- case OP_AV2ARYLEN: new_pp = ab_pp_av2arylen    ; break;
- case OP_AKEYS    : new_pp = ab_pp_keys         ; break;
- case OP_AEACH    : new_pp = ab_pp_each         ; break;
- case OP_RINDEX   :
- case OP_INDEX    : new_pp = ab_pp_index        ; break;
- default: return o;
- }
- {
-  IV const base = current_base();
-  if (base) {
-   ab_map_store(o, o->op_ppaddr, base);
-   o->op_ppaddr = new_pp;
-   /* Break the aelemfast optimisation */
-   if (o->op_type == OP_AELEM) {
-    OP *const first = cBINOPo->op_first;
-    OP *second = OpSIBLING(first);
-    OP *newop;
-    if (second->op_type == OP_CONST) {
-     /* cut out second arg and replace it with a new unop which is
-      * the parent of that arg */
-     op_sibling_splice(o, first, 1, NULL);
-     newop = newUNOP(OP_NULL,0,second);
-     op_sibling_splice(o, first, 0, newop);
-    }
-   }
-  }
-  else ab_map_delete(o);
- }
- return o;
-}
-
-
-STATIC U32 ab_initialized = 0;
-
-/* --- XS ------------------------------------------------------------- */
-
-MODULE = arybase       PACKAGE = arybase
-PROTOTYPES: DISABLE
-
-BOOT:
-{
-    if (!ab_initialized++) {
-       ab_op_map = ptable_new();
-       MUTEX_INIT(&ab_op_map_mutex);
-#define check(uc,lc,ck) \
-               wrap_op_checker(OP_##uc, ab_ck_##ck, &ab_old_ck_##lc)
-       check(SASSIGN,  sassign,  sassign);
-       check(AASSIGN,  aassign,  aassign);
-       check(AELEM,    aelem,    base);
-       check(ASLICE,   aslice,   base);
-       check(LSLICE,   lslice,   base);
-       check(AV2ARYLEN,av2arylen,base);
-       check(SPLICE,   splice,   base);
-       check(KEYS,     keys,     base);
-       check(EACH,     each,     base);
-       check(SUBSTR,   substr,   base);
-       check(RINDEX,   rindex,   base);
-       check(INDEX,    index,    base);
-       check(POS,      pos,      base);
-    }
-}
-
-void
-_tie_it(SV *sv)
-    INIT:
-       GV * const gv = (GV *)sv;
-    CODE:
-       if (GvSV(gv))
-           /* This is *our* scalar now!  */
-           sv_unmagic(GvSV(gv), PERL_MAGIC_sv);
-       tie(aTHX_ GvSVn(gv), NULL, GvSTASH(CvGV(cv)));
-
-void
-FETCH(...)
-    PREINIT:
-       SV *ret = FEATURE_ARYBASE_IS_ENABLED
-                  ? cop_hints_fetch_pvs(PL_curcop, "$[", 0)
-                  : 0;
-    PPCODE:
-       if (!ret || !SvOK(ret)) mXPUSHi(0);
-       else XPUSHs(ret);
-
-void
-STORE(SV *sv, IV newbase)
-    CODE:
-      PERL_UNUSED_VAR(sv);
-      if (FEATURE_ARYBASE_IS_ENABLED) {
-       SV *base = cop_hints_fetch_pvs(PL_curcop, "$[", 0);
-       if (SvOK(base) ? SvIV(base) == newbase : !newbase) XSRETURN_EMPTY;
-       Perl_croak(aTHX_ "That use of $[ is unsupported");
-      }
-      else if (newbase)
-       Perl_croak(aTHX_ "Assigning non-zero to $[ is no longer possible");
-
-
-MODULE = arybase       PACKAGE = arybase::mg
-PROTOTYPES: DISABLE
-
-void
-FETCH(SV *sv)
-    PPCODE:
-       if (!SvROK(sv) || SvTYPE(SvRV(sv)) >= SVt_PVAV)
-           Perl_croak(aTHX_ "Not a SCALAR reference");
-       {
-           SV *base = FEATURE_ARYBASE_IS_ENABLED
-                        ? cop_hints_fetch_pvs(PL_curcop, "$[", 0)
-                        : 0;
-           SvGETMAGIC(SvRV(sv));
-           if (!SvOK(SvRV(sv))) XSRETURN_UNDEF;
-           mXPUSHi(adjust_index_r(
-               SvIV_nomg(SvRV(sv)), base&&SvOK(base)?SvIV(base):0
-           ));
-       }
-
-void
-STORE(SV *sv, SV *newbase)
-    CODE:
-       if (!SvROK(sv) || SvTYPE(SvRV(sv)) >= SVt_PVAV)
-           Perl_croak(aTHX_ "Not a SCALAR reference");
-       {
-           SV *base = FEATURE_ARYBASE_IS_ENABLED
-                       ? cop_hints_fetch_pvs(PL_curcop, "$[", 0)
-                       : 0;
-           SvGETMAGIC(newbase);
-           if (!SvOK(newbase)) SvSetMagicSV(SvRV(sv),&PL_sv_undef);
-           else 
-               sv_setiv_mg(
-                  SvRV(sv),
-                  adjust_index(
-                     SvIV_nomg(newbase), base&&SvOK(base)?SvIV(base):0
-                  )
-               );
-       }
diff --git a/ext/arybase/ptable.h b/ext/arybase/ptable.h
deleted file mode 100644 (file)
index f7919be..0000000
+++ /dev/null
@@ -1,226 +0,0 @@
-/* This is a pointer table implementation essentially copied from the ptr_table
- * implementation in perl's sv.c, except that it has been modified to use memory
- * shared across threads. */
-
-/* This header is designed to be included several times with different
- * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */
-
-#undef pPTBLMS
-#undef pPTBLMS_
-#undef aPTBLMS
-#undef aPTBLMS_
-
-/* Context for PerlMemShared_* functions */
-
-#ifdef PERL_IMPLICIT_SYS
-# define pPTBLMS  pTHX
-# define pPTBLMS_ pTHX_
-# define aPTBLMS  aTHX
-# define aPTBLMS_ aTHX_
-#else
-# define pPTBLMS
-# define pPTBLMS_
-# define aPTBLMS
-# define aPTBLMS_
-#endif
-
-#ifndef pPTBL
-# define pPTBL  pPTBLMS
-#endif
-#ifndef pPTBL_
-# define pPTBL_ pPTBLMS_
-#endif
-#ifndef aPTBL
-# define aPTBL  aPTBLMS
-#endif
-#ifndef aPTBL_
-# define aPTBL_ aPTBLMS_
-#endif
-
-#ifndef PTABLE_NAME
-# define PTABLE_NAME ptable
-#endif
-
-#ifndef PTABLE_VAL_FREE
-# define PTABLE_VAL_FREE(V)
-#endif
-
-#ifndef PTABLE_JOIN
-# define PTABLE_PASTE(A, B) A ## B
-# define PTABLE_JOIN(A, B)  PTABLE_PASTE(A, B)
-#endif
-
-#ifndef PTABLE_PREFIX
-# define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X)
-#endif
-
-#ifndef ptable_ent
-typedef struct ptable_ent {
- struct ptable_ent *next;
- const void *       key;
- void *             val;
-} ptable_ent;
-#define ptable_ent ptable_ent
-#endif /* !ptable_ent */
-
-#ifndef ptable
-typedef struct ptable {
- ptable_ent **ary;
- UV           max;
- UV           items;
-} ptable;
-#define ptable ptable
-#endif /* !ptable */
-
-#ifndef ptable_new
-STATIC ptable *ptable_new(pPTBLMS) {
-#define ptable_new() ptable_new(aPTBLMS)
-  ptable *t = (ptable *)PerlMemShared_malloc(sizeof *t);
- t->max   = 63;
- t->items = 0;
- t->ary   = (ptable_ent **)PerlMemShared_calloc(t->max + 1, sizeof *t->ary);
- return t;
-}
-#endif /* !ptable_new */
-
-#ifndef PTABLE_HASH
-# define PTABLE_HASH(ptr) \
-     ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
-#endif
-
-#ifndef ptable_find
-STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
-#define ptable_find ptable_find
- ptable_ent *ent;
- const UV hash = PTABLE_HASH(key);
-
- ent = t->ary[hash & t->max];
- for (; ent; ent = ent->next) {
-  if (ent->key == key)
-   return ent;
- }
-
- return NULL;
-}
-#endif /* !ptable_find */
-
-#ifndef ptable_fetch
-STATIC void *ptable_fetch(const ptable * const t, const void * const key) {
-#define ptable_fetch ptable_fetch
- const ptable_ent *const ent = ptable_find(t, key);
-
- return ent ? ent->val : NULL;
-}
-#endif /* !ptable_fetch */
-
-#ifndef ptable_split
-STATIC void ptable_split(pPTBLMS_ ptable * const t) {
-#define ptable_split(T) ptable_split(aPTBLMS_ (T))
- ptable_ent **ary = t->ary;
- const UV oldsize = t->max + 1;
- UV newsize = oldsize * 2;
- UV i;
-
- ary = (ptable_ent **)PerlMemShared_realloc(ary, newsize * sizeof(*ary));
- Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
- t->max = --newsize;
- t->ary = ary;
-
- for (i = 0; i < oldsize; i++, ary++) {
-  ptable_ent **currentp, **entp, *ent;
-  if (!*ary)
-   continue;
-  currentp = ary + oldsize;
-  for (entp = ary, ent = *ary; ent; ent = *entp) {
-   if ((newsize & PTABLE_HASH(ent->key)) != i) {
-    *entp     = ent->next;
-    ent->next = *currentp;
-    *currentp  = ent;
-    continue;
-   } else
-    entp = &ent->next;
-  }
- }
-}
-#endif /* !ptable_split */
-
-STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) {
- ptable_ent *ent = ptable_find(t, key);
-
- if (ent) {
-  void *oldval = ent->val;
-  PTABLE_VAL_FREE(oldval);
-  ent->val = val;
- } else if (val) {
-  const UV i = PTABLE_HASH(key) & t->max;
-  ent = (ptable_ent *)PerlMemShared_malloc(sizeof *ent);
-  ent->key  = key;
-  ent->val  = val;
-  ent->next = t->ary[i];
-  t->ary[i] = ent;
-  t->items++;
-  if (ent->next && t->items > t->max)
-   ptable_split(t);
- }
-}
-
-/* this function appears to be unused */
-#if 0
-#ifndef ptable_walk
-STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) {
-#define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD))
- if (t && t->items) {
-  ptable_ent ** const array = t->ary;
-  UV i = t->max;
-  do {
-   ptable_ent *entry;
-   for (entry = array[i]; entry; entry = entry->next)
-    cb(aTHX_ entry, userdata);
-  } while (i--);
- }
-}
-#endif /* !ptable_walk */
-#endif
-
-/* this function appears to be unused */
-#if 0
-STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) {
- if (t && t->items) {
-  ptable_ent ** const array = t->ary;
-  UV i = t->max;
-
-  do {
-   ptable_ent *entry = array[i];
-   while (entry) {
-    ptable_ent * const oentry = entry;
-    void *val = oentry->val;
-    entry = entry->next;
-    PTABLE_VAL_FREE(val);
-    PerlMemShared_free(oentry);
-   }
-   array[i] = NULL;
-  } while (i--);
-
-  t->items = 0;
- }
-}
-#endif
-
-/* this function appears to be unused */
-#if 0
-STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) {
- if (!t)
-  return;
- PTABLE_PREFIX(_clear)(aPTBL_ t);
- PerlMemShared_free(t->ary);
- PerlMemShared_free(t);
-}
-#endif
-
-#undef pPTBL
-#undef pPTBL_
-#undef aPTBL
-#undef aPTBL_
-
-#undef PTABLE_NAME
-#undef PTABLE_VAL_FREE
diff --git a/ext/arybase/t/aeach.t b/ext/arybase/t/aeach.t
deleted file mode 100644 (file)
index 241677a..0000000
+++ /dev/null
@@ -1,45 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-BEGIN {
-       if("$]" < 5.011) {
-               require Test::More;
-               Test::More::plan(skip_all => "no array each on this Perl");
-       }
-}
-
-use Test::More tests => 2;
-
-our @activity;
-
-$[ = 3;
-
-our @t0 = qw(a b c);
-@activity = ();
-foreach(0..5) {
-       push @activity, [ each(@t0) ];
-}
-is_deeply \@activity, [
-       [ 3, "a" ],
-       [ 4, "b" ],
-       [ 5, "c" ],
-       [],
-       [ 3, "a" ],
-       [ 4, "b" ],
-];
-
-our @t1 = qw(a b c);
-@activity = ();
-foreach(0..5) {
-       push @activity, [ scalar each(@t1) ];
-}
-is_deeply \@activity, [
-       [ 3 ],
-       [ 4 ],
-       [ 5 ],
-       [ undef ],
-       [ 3 ],
-       [ 4 ],
-];
-
-1;
diff --git a/ext/arybase/t/aelem.t b/ext/arybase/t/aelem.t
deleted file mode 100644 (file)
index c26a2a8..0000000
+++ /dev/null
@@ -1,56 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 33;
-
-our @t = qw(a b c d e f);
-our $r = \@t;
-our($i3, $i4, $i8, $i9) = (3, 4, 8, 9);
-our @i4 = (3, 3, 3, 3);
-
-$[ = 3;
-
-is $t[3], "a";
-is $t[4], "b";
-is $t[8], "f";
-is $t[9], undef;
-is_deeply [ scalar $t[4] ], [ "b" ];
-is_deeply [ $t[4] ], [ "b" ];
-
-is $t[2], 'f';
-is $t[-1], 'f';
-is $t[1], 'e';
-is $t[-2], 'e';
-
-{
- $[ = -3;
- is $t[-3], 'a';
-}
-
-is $r->[3], "a";
-is $r->[4], "b";
-is $r->[8], "f";
-is $r->[9], undef;
-is_deeply [ scalar $r->[4] ], [ "b" ];
-is_deeply [ $r->[4] ], [ "b" ];
-
-is $t[$i3], "a";
-is $t[$i4], "b";
-is $t[$i8], "f";
-is $t[$i9], undef;
-is_deeply [ scalar $t[$i4] ], [ "b" ];
-is_deeply [ $t[$i4] ], [ "b" ];
-is_deeply [ scalar $t[@i4] ], [ "b" ];
-is_deeply [ $t[@i4] ], [ "b" ];
-
-is $r->[$i3], "a";
-is $r->[$i4], "b";
-is $r->[$i8], "f";
-is $r->[$i9], undef;
-is_deeply [ scalar $r->[$i4] ], [ "b" ];
-is_deeply [ $r->[$i4] ], [ "b" ];
-is_deeply [ scalar $r->[@i4] ], [ "b" ];
-is_deeply [ $r->[@i4] ], [ "b" ];
-
-
-1;
diff --git a/ext/arybase/t/akeys.t b/ext/arybase/t/akeys.t
deleted file mode 100644 (file)
index a76fade..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-BEGIN {
-       if("$]" < 5.011) {
-               require Test::More;
-               Test::More::plan(skip_all => "no array keys on this Perl");
-       }
-}
-
-use Test::More tests => 4;
-
-our @t;
-
-$[ = 3;
-
-@t = ();
-is_deeply [ scalar keys @t ], [ 0 ];
-is_deeply [ keys @t ], [];
-
-@t = qw(a b c d e f);
-is_deeply [ scalar keys @t ], [ 6 ];
-is_deeply [ keys @t ], [ 3, 4, 5, 6, 7, 8 ];
-
-1;
diff --git a/ext/arybase/t/arybase.t b/ext/arybase/t/arybase.t
deleted file mode 100644 (file)
index f3d3287..0000000
+++ /dev/null
@@ -1,37 +0,0 @@
-#!perl
-
-# Basic tests for $[ as a variable
-# plus miscellaneous bug fix tests
-
-no warnings 'deprecated';
-use Test::More tests => 7;
-
-sub outside_base_scope { return "${'['}" }
-
-$[ = 3;
-my $base = \$[;
-is "$$base", 3, 'retval of $[';
-is outside_base_scope, 0, 'retval of $[ outside its scope';
-
-${'['} = 3;
-pass('run-time $[ = 3 assignment (in $[ = 3 scope)');
-{
-  $[ = 0;
-  ${'['} = 0;
-  pass('run-time $[ = 0 assignment (in $[ = 3 scope)');
-}
-
-eval { ${'['} = 1 }; my $f = __FILE__; my $l = __LINE__;
-is $@, "That use of \$[ is unsupported at $f line $l.\n",
-   "error when setting $[ to integer other than current base at run-time";
-
-$[ = 6.7;
-is "$[", 6, '$[ is an integer';
-
-eval { my $x = 45; $[ = \$x }; $l = __LINE__;
-is $@, "That use of \$[ is unsupported at $f line $l.\n",
-   'error when setting $[ to ref';
-
-sub foo { my $x; $x = wait } # compilation of this routine used to crash
-
-1;
diff --git a/ext/arybase/t/aslice.t b/ext/arybase/t/aslice.t
deleted file mode 100644 (file)
index 20782e5..0000000
+++ /dev/null
@@ -1,27 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 10;
-
-our @t = qw(a b c d e f);
-our $r = \@t;
-our @i4 = (3, 5, 3, 5);
-
-$[ = 3;
-
-is_deeply [ scalar @t[3,4] ], [ qw(b) ];
-is_deeply [ @t[3,4,8,9] ], [ qw(a b f), undef ];
-is_deeply [ scalar @t[@i4] ], [ qw(c) ];
-is_deeply [ @t[@i4] ], [ qw(a c a c) ];
-is_deeply [ scalar @{$r}[3,4] ], [ qw(b) ];
-is_deeply [ @{$r}[3,4,8,9] ], [ qw(a b f), undef ];
-is_deeply [ scalar @{$r}[@i4] ], [ qw(c) ];
-is_deeply [ @{$r}[@i4] ], [ qw(a c a c) ];
-
-is_deeply [ @t[2,-1,1,-2] ], [ qw(f f e e) ];
-{
- $[ = -3;
- is_deeply [@t[-3,()]], ['a'];
-}
-
-1;
diff --git a/ext/arybase/t/av2arylen.t b/ext/arybase/t/av2arylen.t
deleted file mode 100644 (file)
index 6c1deb2..0000000
+++ /dev/null
@@ -1,26 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 8;
-
-our @t = qw(a b c d e f);
-our $r = \@t;
-
-$[ = 3;
-
-is_deeply [ scalar $#t ], [ 8 ];
-is_deeply [ $#t ], [ 8 ];
-is_deeply [ scalar $#$r ], [ 8 ];
-is_deeply [ $#$r ], [ 8 ];
-
-my $arylen=\$#t;
-push @t, 'g';
-is 0+$$arylen, 9;
-$[ = 4;
-is 0+$$arylen, 10;
---$$arylen;
-$[ = 3;
-is 0+$$arylen, 8;
-is 0+$#t, 8;
-
-1;
diff --git a/ext/arybase/t/index.t b/ext/arybase/t/index.t
deleted file mode 100644 (file)
index 86dde88..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 12;
-
-our $t = "abcdefghijkl";
-
-$[ = 3;
-
-is index($t, "cdef"), 5;
-is index($t, "cdef", 3), 5;
-is index($t, "cdef", 4), 5;
-is index($t, "cdef", 5), 5;
-is index($t, "cdef", 6), 2;
-is index($t, "cdef", 7), 2;
-is rindex($t, "cdef"), 5;
-is rindex($t, "cdef", 7), 5;
-is rindex($t, "cdef", 6), 5;
-is rindex($t, "cdef", 5), 5;
-is rindex($t, "cdef", 4), 2;
-is rindex($t, "cdef", 3), 2;
-
-1;
diff --git a/ext/arybase/t/lslice.t b/ext/arybase/t/lslice.t
deleted file mode 100644 (file)
index 08aabe9..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 8;
-
-our @i4 = (3, 5, 3, 5);
-
-$[ = 3;
-
-is_deeply [ scalar qw(a b c d e f)[3,4] ], [ qw(b) ];
-is_deeply [ qw(a b c d e f)[3,4,8,9] ], [ qw(a b f), undef ];
-is_deeply [ scalar qw(a b c d e f)[@i4] ], [ qw(c) ];
-is_deeply [ qw(a b c d e f)[@i4] ], [ qw(a c a c) ];
-is_deeply [ 3, 4, qw(a b c d e f)[@i4] ], [ 3, 4, qw(a c a c) ];
-
-is_deeply [ qw(a b c d e f)[-1,-2] ], [ qw(f e) ];
-is_deeply [ qw(a b c d e f)[2,1] ], [ qw(f e) ];
-{
- $[ = -3;
- is_deeply [qw(a b c d e f)[-3]], ['a'];
-}
-
-1;
diff --git a/ext/arybase/t/pos.t b/ext/arybase/t/pos.t
deleted file mode 100644 (file)
index 970e17e..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 12;
-
-our $t = "abcdefghi";
-scalar($t =~ /abcde/g);
-our $r = \$t;
-
-$[ = 3;
-
-is_deeply [ scalar pos($t) ], [ 8 ];
-is_deeply [ pos($t) ], [ 8 ];
-is_deeply [ scalar pos($$r) ], [ 8 ];
-is_deeply [ pos($$r) ], [ 8 ];
-
-scalar($t =~ /x/g);
-
-is_deeply [ scalar pos($t) ], [ undef ];
-is_deeply [ pos($t) ], [ undef ];
-is_deeply [ scalar pos($$r) ], [ undef ];
-is_deeply [ pos($$r) ], [ undef ];
-
-is pos($t), undef;
-pos($t) = 5;
-is 0+pos($t), 5;
-is pos($t), 2;
-my $posr =\ pos($t);
-$$posr = 4;
-{
-  $[ = 0;
-  is 0+$$posr, 1;
-}
-
-1;
diff --git a/ext/arybase/t/scope.t b/ext/arybase/t/scope.t
deleted file mode 100644 (file)
index 5fca196..0000000
+++ /dev/null
@@ -1,44 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 14;
-
-our @t = qw(a b c d e f);
-
-is $t[3], "d";
-$[ = 3;
-is $t[3], "a";
-{
-       is $t[3], "a";
-       $[ = -1;
-       is $t[3], "e";
-       $[ = +0;
-       is $t[3], "d";
-       $[ = +1;
-       is $t[3], "c";
-       $[ = 0;
-       is $t[3], "d";
-}
-is $t[3], "a";
-{
-       local $[ = -1;
-       is $t[3], "e";
-}
-is $t[3], "a";
-{
-       ($[) = -1;
-       is $t[3], "e";
-}
-is $t[3], "a";
-BEGIN { push @INC, '.' }
-use t::scope_0;
-is scope0_test(), "d";
-
-
-is eval(q{
-       $[ = 3;
-       BEGIN { my $x = "foo\x{666}"; $x =~ /foo\p{Alnum}/; }
-       $t[3];
-}), "a";
-
-1;
diff --git a/ext/arybase/t/scope_0.pm b/ext/arybase/t/scope_0.pm
deleted file mode 100644 (file)
index 9f6c783..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-use warnings;
-use strict;
-
-sub main::scope0_test { $main::t[3] }
-
-1;
diff --git a/ext/arybase/t/splice.t b/ext/arybase/t/splice.t
deleted file mode 100644 (file)
index 9fd618a..0000000
+++ /dev/null
@@ -1,65 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 23;
-
-our @t;
-our @i5 = (3, 3, 3, 3, 3);
-
-$[ = 3;
-
-@t = qw(a b c d e f);
-is_deeply [ scalar splice @t ], [qw(f)];
-is_deeply \@t, [];
-
-@t = qw(a b c d e f);
-is_deeply [ splice @t ], [qw(a b c d e f)];
-is_deeply \@t, [];
-
-@t = qw(a b c d e f);
-is_deeply [ scalar splice @t, 5 ], [qw(f)];
-is_deeply \@t, [qw(a b)];
-
-@t = qw(a b c d e f);
-is_deeply [ splice @t, 5 ], [qw(c d e f)];
-is_deeply \@t, [qw(a b)];
-
-@t = qw(a b c d e f);
-is_deeply [ scalar splice @t, @i5 ], [qw(f)];
-is_deeply \@t, [qw(a b)];
-
-@t = qw(a b c d e f);
-is_deeply [ splice @t, @i5 ], [qw(c d e f)];
-is_deeply \@t, [qw(a b)];
-
-@t = qw(a b c d e f);
-is_deeply [ scalar splice @t, 5, 2 ], [qw(d)];
-is_deeply \@t, [qw(a b e f)];
-
-@t = qw(a b c d e f);
-is_deeply [ splice @t, 5, 2 ], [qw(c d)];
-is_deeply \@t, [qw(a b e f)];
-
-@t = qw(a b c d e f);
-is_deeply [ scalar splice @t, 5, 2, qw(x y z) ], [qw(d)];
-is_deeply \@t, [qw(a b x y z e f)];
-
-@t = qw(a b c d e f);
-is_deeply [ splice @t, 5, 2, qw(x y z) ], [qw(c d)];
-is_deeply \@t, [qw(a b x y z e f)];
-
-@t = qw(a b c d e f);
-splice @t, -4, 1;
-is_deeply \@t, [qw(a b d e f)];
-
-@t = qw(a b c d e f);
-splice @t, 1, 1;
-is_deeply \@t, [qw(a b c d f)];
-
-$[ = -3;
-
-@t = qw(a b c d e f);
-splice @t, -3, 1;
-is_deeply \@t, [qw(b c d e f)];
-
-1;
diff --git a/ext/arybase/t/substr.t b/ext/arybase/t/substr.t
deleted file mode 100644 (file)
index ecfba48..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-use warnings; no warnings 'deprecated';
-use strict;
-
-use Test::More tests => 6;
-
-our $t;
-
-$[ = 3;
-
-$t = "abcdef";
-is substr($t, 5), "cdef";
-is $t, "abcdef";
-
-$t = "abcdef";
-is substr($t, 5, 2), "cd";
-is $t, "abcdef";
-
-$t = "abcdef";
-is substr($t, 5, 2, "xyz"), "cd";
-is $t, "abxyzef";
-
-1;
index 0e15fb5..52ace09 100644 (file)
--- a/feature.h
+++ b/feature.h
         FEATURE_IS_ENABLED("evalbytes")) \
     )
 
-#define FEATURE_ARYBASE_IS_ENABLED \
-    ( \
-       CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_511 \
-     || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
-        FEATURE_IS_ENABLED("arybase")) \
-    )
-
 #define FEATURE_SIGNATURES_IS_ENABLED \
     ( \
        CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
diff --git a/gv.c b/gv.c
index 085bf74..4f3a272 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1880,7 +1880,7 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
  * a new GV.
  * Note that it does not insert the GV into the stash prior to
  * magicalization, which some variables require need in order
- * to work (like $[, %+, %-, %!), so callers must take care of
+ * to work (like %+, %-, %!), so callers must take care of
  * that.
  * 
  * It returns true if the gv did turn out to be magical one; i.e.,
@@ -2215,13 +2215,6 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                hv_magic(hv, NULL, PERL_MAGIC_hints);
            }
            goto magicalize;
-       case '[':               /* $[ */
-           if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
-            && FEATURE_ARYBASE_IS_ENABLED) {
-                require_tie_mod_s(gv,'[',"arybase",0);
-           }
-           else goto magicalize;
-            break;
        case '\023':    /* $^S */
        ro_magicalize:
            SvREADONLY_on(GvSVn(gv));
@@ -2240,6 +2233,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        case '/':               /* $/ */
        case '|':               /* $| */
        case '$':               /* $$ */
+       case '[':               /* $[ */
        case '\001':    /* $^A */
        case '\003':    /* $^C */
        case '\004':    /* $^D */
@@ -2326,9 +2320,6 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
     }
     if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
       switch (*name) {
-      case '[':
-          require_tie_mod_s(gv,'[',"arybase",0);
-          break;
 #ifdef PERL_SAWAMPERSAND
       case '`':
           PL_sawampersand |= SAWAMPERSAND_LEFT;
index 626aa67..9a38e68 100644 (file)
 /Win32CORE.pm
 /XS/
 /XSLoader.pm
-/arybase.pm
 /attributes.pm
 /autodie.pm
 /autodie/
index 57746af..0301aa5 100644 (file)
@@ -5,7 +5,7 @@
 
 package feature;
 
-our $VERSION = '1.53';
+our $VERSION = '1.54';
 
 our %feature = (
     fc              => 'feature_fc',
@@ -14,7 +14,6 @@ our %feature = (
     switch          => 'feature_switch',
     bitwise         => 'feature_bitwise',
     evalbytes       => 'feature_evalbytes',
-    array_base      => 'feature_arybase',
     signatures      => 'feature_signatures',
     current_sub     => 'feature___SUB__',
     refaliasing     => 'feature_refaliasing',
@@ -25,13 +24,13 @@ our %feature = (
 );
 
 our %feature_bundle = (
-    "5.10"    => [qw(array_base say state switch)],
-    "5.11"    => [qw(array_base say state switch unicode_strings)],
+    "5.10"    => [qw(say state switch)],
+    "5.11"    => [qw(say state switch unicode_strings)],
     "5.15"    => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
     "5.23"    => [qw(current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)],
     "5.27"    => [qw(bitwise current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)],
-    "all"     => [qw(array_base bitwise current_sub declared_refs evalbytes fc postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
-    "default" => [qw(array_base)],
+    "all"     => [qw(bitwise current_sub declared_refs evalbytes fc postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
+    "default" => [qw()],
 );
 
 $feature_bundle{"5.12"} = $feature_bundle{"5.11"};
@@ -55,6 +54,9 @@ my %noops = (
     postderef => 1,
     lexical_subs => 1,
 );
+my %removed = (
+    array_base => 1,
+);
 
 our $hint_shift   = 26;
 our $hint_mask    = 0x1c000000;
@@ -211,9 +213,9 @@ This feature is available starting with Perl 5.16.
 
 =head2 The 'array_base' feature
 
-This feature supports the legacy C<$[> variable.  See L<perlvar/$[> and
-L<arybase>.  It is on by default but disabled under C<use v5.16> (see
-L</IMPLICIT LOADING>, below).
+This feature supported the legacy C<$[> variable.  See L<perlvar/$[>.
+It was on by default but disabled under C<use v5.16> (see
+L</IMPLICIT LOADING>, below) and unavailable since perl 5.30.
 
 This feature is available under this name starting with Perl 5.16.  In
 previous versions, it was simply on all the time, and this pragma knew
@@ -358,13 +360,13 @@ The following feature bundles are available:
 
   bundle    features included
   --------- -----------------
-  :default  array_base
+  :default
 
-  :5.10     say state switch array_base
+  :5.10     say state switch
 
-  :5.12     say state switch unicode_strings array_base
+  :5.12     say state switch unicode_strings
 
-  :5.14     say state switch unicode_strings array_base
+  :5.14     say state switch unicode_strings
 
   :5.16     say state switch unicode_strings
             unicode_eval evalbytes current_sub fc
@@ -505,6 +507,9 @@ sub __common {
             if (exists $noops{$name}) {
                 next;
             }
+            if (!$import && exists $removed{$name}) {
+                next;
+            }
             unknown_feature($name);
         }
        if ($import) {
diff --git a/op.c b/op.c
index d0dcffb..03f066d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -14707,7 +14707,7 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
             /* at this point we're looking for an OP_AELEM, OP_HELEM,
              * OP_EXISTS or OP_DELETE */
 
-            /* if something like arybase (a.k.a $[ ) is in scope,
+            /* if a custom array/hash access checker is in scope,
              * abandon optimisation attempt */
             if (  (o->op_type == OP_AELEM || o->op_type == OP_HELEM)
                && PL_check[o->op_type] != Perl_ck_null)
index 36178a1..221d0df 100644 (file)
@@ -45,6 +45,12 @@ XXX For a release on a stable branch, this section aspires to be:
 
 [ List each incompatible change as a =head2 entry ]
 
+=head2 Assigning non-zero to C<$[> is fatal
+
+Setting L<< C<$[>|perlvar/$[ >> to a non-zero value has been deprecated since
+Perl 5.12 and now throws a fatal error.
+See L<<< perldeprecation/Assigning non-zero to C<< $[ >> is fatal >>>.
+
 =head1 Deprecations
 
 XXX Any deprecated features, syntax, modules etc. should be listed here.
index 938d678..f3b5308 100644 (file)
@@ -136,14 +136,14 @@ error in Perl 5.30.
 To specify how numbers are formatted when printed, one is advised
 to use C<< printf >> or C<< sprintf >> instead.
 
-=head3 Assigning non-zero to C<< $[ >> will be fatal
+=head3 Assigning non-zero to C<< $[ >> is fatal
 
 This variable (and the corresponding C<array_base> feature and
-L<arybase> module) allows changing the base for array and string
+L<arybase> module) allowed changing the base for array and string
 indexing operations.
 
 Setting this to a non-zero value has been deprecated since Perl 5.12 and
-will become fatal in Perl 5.30.
+throws a fatal error as of Perl 5.30.
 
 =head3 C<< File::Glob::glob() >> will disappear
 
index 2c1fe74..17b96ca 100644 (file)
@@ -264,7 +264,8 @@ an array, or an array to a hash; the two types must match.
 
 =item Assigning non-zero to $[ is no longer possible
 
-(F) When the "array_base" feature is disabled (e.g., under C<use v5.16;>)
+(F) When the "array_base" feature is disabled
+(e.g., and under C<use v5.16;>, and as of Perl 5.30)
 the special variable C<$[>, which is deprecated, is now a fixed zero value.
 
 =item Assignment to both a list and a scalar
@@ -6109,21 +6110,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/$[> and L<arybase>.
-
 =item The alpha_assertions feature is experimental
 
 (S experimental::alpha_assertions) This feature is experimental
@@ -7188,13 +7174,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, and will be fatal in 5.30
-
-(D deprecated) The C<$[> variable (index of the first element in an array)
-is deprecated since Perl 5.12, and setting it to a non-zero value will be
-fatal as of Perl 5.30.
-See L<perlvar/"$[">.
-
 =item Use of bare << to mean <<"" is forbidden
 
 (F) You are now required to use the explicitly quoted form if you wish
index 114a7e0..5faea28 100644 (file)
@@ -2371,19 +2371,16 @@ 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.
 
-As of Perl v5.16.0, it is implemented by the L<arybase> module.  See
-L<arybase> for more details on its behaviour.
+As of Perl v5.16.0, it is implemented by the L<arybase> module.
 
-Under C<use v5.16>, or C<no feature "array_base">, C<$[> no longer has any
-effect, and always contains 0.  Assigning 0 to it is permitted, but any
-other value will produce an error.
+As of Perl v5.30.0, or under C<use v5.16>, or C<no feature "array_base">,
+C<$[> no longer has any effect, and always contains 0.
+Assigning 0 to it is permitted, but any other value will produce an error.
 
 Mnemonic: [ begins subscripts.
 
 Deprecated in Perl v5.12.0.
 
-Assigning a non-zero value be fatal in Perl v5.30.0.
-
 =back
 
 =cut
index aba644f..89d46af 100755 (executable)
@@ -27,7 +27,6 @@ my %feature = (
     switch          => 'switch',
     bitwise         => 'bitwise',
     evalbytes       => 'evalbytes',
-    array_base      => 'arybase',
     current_sub     => '__SUB__',
     refaliasing     => 'refaliasing',
     postderef_qq    => 'postderef_qq',
@@ -45,11 +44,11 @@ my %feature = (
 # 5.odd implies the next 5.even, but an explicit 5.even can override it.
 my %feature_bundle = (
      all     => [ keys %feature ],
-     default =>        [qw(array_base)],
-    "5.9.5"  =>        [qw(say state switch array_base)],
-    "5.10"   =>        [qw(say state switch array_base)],
-    "5.11"   =>        [qw(say state switch unicode_strings array_base)],
-    "5.13"   =>        [qw(say state switch unicode_strings array_base)],
+     default =>        [qw()],
+    "5.9.5"  =>        [qw(say state switch)],
+    "5.10"   =>        [qw(say state switch)],
+    "5.11"   =>        [qw(say state switch unicode_strings)],
+    "5.13"   =>        [qw(say state switch unicode_strings)],
     "5.15"   =>        [qw(say state switch unicode_strings unicode_eval
                    evalbytes current_sub fc)],
     "5.17"   =>        [qw(say state switch unicode_strings unicode_eval
@@ -69,6 +68,7 @@ my %feature_bundle = (
 );
 
 my @noops = qw( postderef lexical_subs );
+my @removed = qw( array_base );
 
 
 ###########################################################################
@@ -195,6 +195,10 @@ print $pm "my \%noops = (\n";
 print $pm "    $_ => 1,\n", for @noops;
 print $pm ");\n";
 
+print $pm "my \%removed = (\n";
+print $pm "    $_ => 1,\n", for @removed;
+print $pm ");\n";
+
 print $pm <<EOPM;
 
 our \$hint_shift   = $HintShift;
@@ -371,7 +375,7 @@ read_only_bottom_close_and_rename($h);
 __END__
 package feature;
 
-our $VERSION = '1.53';
+our $VERSION = '1.54';
 
 FEATURES
 
@@ -521,9 +525,9 @@ This feature is available starting with Perl 5.16.
 
 =head2 The 'array_base' feature
 
-This feature supports the legacy C<$[> variable.  See L<perlvar/$[> and
-L<arybase>.  It is on by default but disabled under C<use v5.16> (see
-L</IMPLICIT LOADING>, below).
+This feature supported the legacy C<$[> variable.  See L<perlvar/$[>.
+It was on by default but disabled under C<use v5.16> (see
+L</IMPLICIT LOADING>, below) and unavailable since perl 5.30.
 
 This feature is available under this name starting with Perl 5.16.  In
 previous versions, it was simply on all the time, and this pragma knew
@@ -780,6 +784,9 @@ sub __common {
             if (exists $noops{$name}) {
                 next;
             }
+            if (!$import && exists $removed{$name}) {
+                next;
+            }
             unknown_feature($name);
         }
        if ($import) {
index 5eacaff..d12c791 100644 (file)
@@ -83,40 +83,24 @@ custom sub
 # SKIP ? not defined DynaLoader::boot_DynaLoader
 no feature;
 use feature ":default";
+$[ = 0;
 $[ = 1;
-print qw[a b c][2], "\n";
-use feature ":5.16"; # should not disable anything; no feature ':all' does that
-print qw[a b c][2], "\n";
-no feature ':all';
-print qw[a b c][2], "\n";
-use feature ":5.16";
-print qw[a b c][2], "\n";
-EXPECT
-Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 4.
-b
-b
-c
-c
+EXPECT
+Assigning non-zero to $[ is no longer possible at - line 5.
 ########
 # "no feature"
 use feature ':5.16'; # turns array_base off
-no feature; # resets to :default, thus turns array_base on
+no feature; # resets to :default, thus would turn array_base on, if it still existed
+$[ = 0;
 $[ = 1;
-print qw[a b c][2], "\n";
 EXPECT
-Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 4.
-b
+Assigning non-zero to $[ is no longer possible at - line 5.
 ########
 # "no feature 'all"
-$[ = 1;
-print qw[a b c][2], "\n";
 no feature ':all'; # turns array_base (and everything else) off
 $[ = 1;
-print qw[a b c][2], "\n";
 EXPECT
-Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 2.
-Assigning non-zero to $[ is no longer possible at - line 5.
-b
+Assigning non-zero to $[ is no longer possible at - line 3.
 ########
 # NAME $^H accidentally enabling all features
 eval 'BEGIN { $^H |= 0x1c020000 } $_ = evalbytes 12345';
index 79f1bf8..a6c47ef 100644 (file)
@@ -73,38 +73,6 @@ yes
 evalbytes sub
 say sub
 ########
-# No $[ under 5.15
-# SKIP ? not defined DynaLoader::boot_DynaLoader
-use v5.14;
-no warnings 'deprecated';
-$[ = 1;
-print qw[a b c][2], "\n";
-use v5.15;
-print qw[a b c][2], "\n";
-EXPECT
-b
-c
-########
-# $[ under < 5.10
-# SKIP ? not defined DynaLoader::boot_DynaLoader
-use feature 'say'; # make sure it is loaded and modifies %^H; we are test-
-use v5.8.8;        # ing to make sure it does not disable $[
-no warnings 'deprecated';
-$[ = 1;
-print qw[a b c][2], "\n";
-EXPECT
-b
-########
-# $[ under < 5.10 after use v5.15
-# SKIP ? not defined DynaLoader::boot_DynaLoader
-use v5.15;
-use v5.8.8;
-no warnings 'deprecated';
-$[ = 1;
-print qw[a b c][2], "\n";
-EXPECT
-b
-########
 # Implicit unicode_string feature
 use v5.14;
 my $sharp_s = chr utf8::unicode_to_native(0xdf);
diff --git a/t/lib/feature/removed b/t/lib/feature/removed
new file mode 100644 (file)
index 0000000..f2805ee
--- /dev/null
@@ -0,0 +1,10 @@
+Test that removed features can be disabled, but not enabled.
+
+__END__
+use feature "array_base";
+EXPECT
+OPTIONS regex
+^Feature "array_base" is not supported by Perl [v0-9.]+ at - line 1.
+########
+no feature "array_base";
+EXPECT
index 54e2e3d..a2a1e2e 100644 (file)
@@ -1699,22 +1699,6 @@ Deprecated use of my() in false conditional. This will be a fatal error in Perl
 Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 8.
 ########
 # op.c
-$[ = 1;
-($[) = 1;
-use warnings 'deprecated';
-$[ = 2;
-($[) = 2;
-$[ = 0;
-no warnings 'deprecated';
-$[ = 3;
-($[) = 3;
-EXPECT
-Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 2.
-Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 3.
-Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 5.
-Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 6.
-########
-# op.c
 use warnings 'void';
 @x = split /y/, "z";
 $x = split /y/, "z";
diff --git a/t/op/array_base.t b/t/op/array_base.t
deleted file mode 100644 (file)
index a30236d..0000000
+++ /dev/null
@@ -1,41 +0,0 @@
-#!perl -w
-use strict;
-
-BEGIN {
- chdir 't' if -d 't';
- require './test.pl';
-
- plan (tests => my $tests = 11);
-
- # Run these at BEGIN time, before arybase loads
- use v5.15;
- is(eval('$[ = 1; 123'), undef);
- like($@, qr/\AAssigning non-zero to \$\[ is no longer possible/);
-
- if (is_miniperl()) {
-   # skip the rest
-   SKIP: { skip ("no arybase.xs on miniperl", $tests-2) }
-   exit;
- }
-}
-
-no warnings 'deprecated';
-
-is(eval('$['), 0);
-is(eval('$[ = 0; 123'), 123);
-is(eval('$[ = 1; 123'), 123);
-$[ = 1;
-ok $INC{'arybase.pm'};
-
-use v5.15;
-is(eval('$[ = 1; 123'), undef);
-like($@, qr/\AAssigning non-zero to \$\[ is no longer possible/);
-is $[, 0, '$[ is 0 under 5.16';
-$_ = "hello";
-/l/g;
-my $pos = \pos;
-is $$pos, 3;
-$$pos = 1;
-is $$pos, 1;
-
-1;
index 02ced15..f53cc5e 100644 (file)
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
     set_up_inc( '../lib' );
-    plan (tests => 196); # some tests are run in BEGIN block
+    plan (tests => 195); # some tests are run in BEGIN block
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -615,7 +615,7 @@ SKIP: {
 SKIP: {
     skip_if_miniperl("No XS in miniperl", 3);
 
-    for ( [qw( %- Tie::Hash::NamedCapture )], [qw( $[ arybase )],
+    for ( [qw( %- Tie::Hash::NamedCapture )],
           [qw( %! Errno )] ) {
        my ($var, $mod) = @$_;
        my $modfile = $mod =~ s|::|/|gr . ".pm";
index 2e5c299..671f6c7 100644 (file)
@@ -22,6 +22,7 @@ Apache::MP3
 Apache::SmallProf
 Archive::Extract
 Array::Base
+arybase
 atan2(3)
 atoi(3)
 Attribute::Constant
index a1f7cc2..852ecaa 100644 (file)
@@ -6,7 +6,6 @@
 BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
-    skip_all_if_miniperl("miniperl, no arybase");
     skip_all_without_unicode_tables();
 }
 
@@ -15,7 +14,7 @@ use utf8;
 use open qw( :utf8 :std );
 no warnings qw(misc reserved);
 
-plan (tests => 66894);
+plan (tests => 66892);
 
 # ${single:colon} should not be treated as a simple variable, but as a
 # block with a label inside.
@@ -56,9 +55,8 @@ plan (tests => 66894);
 }
 
 # Checking that at least some of the special variables work
-for my $v (qw( ^V ; < > ( ) {^GLOBAL_PHASE} ^W _ 1 4 0 ] ! @ / \ = )) {
+for my $v (qw( ^V ; < > ( ) {^GLOBAL_PHASE} ^W _ 1 4 0 ] ! @ / \ = )) {
   SKIP: {
-    skip_if_miniperl('No $[ under miniperl', 2) if $v eq '[';
     local $@;
     evalbytes "\$$v;";
     is $@, '', "No syntax error for \$$v";