diff options
author | Zefram <zefram@fysh.org> | 2011-09-09 23:27:16 +0100 |
---|---|---|
committer | Zefram <zefram@fysh.org> | 2011-09-09 23:30:02 +0100 |
commit | e1dccc0d34a90e3511bfed596be9d78128ca7ee7 (patch) | |
tree | 1e72ad2098f66ac1c59debfc46c00d1013fc0a9f /dist | |
parent | 0b31f5359876e6c0b203006714db218d7b441cd1 (diff) | |
download | perl-e1dccc0d34a90e3511bfed596be9d78128ca7ee7.tar.gz |
remove index offsetting ($[)
$[ remains as a variable. It no longer has compile-time magic.
At runtime, it always reads as zero, accepts a write of zero, but dies
on writing any other value.
Diffstat (limited to 'dist')
-rw-r--r-- | dist/B-Deparse/Deparse.pm | 43 | ||||
-rw-r--r-- | dist/B-Deparse/t/deparse.t | 1 |
2 files changed, 8 insertions, 36 deletions
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, ); } |