diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | feature.h | 47 | ||||
| -rw-r--r-- | lib/feature.pm | 116 | ||||
| -rw-r--r-- | op.c | 14 | ||||
| -rw-r--r-- | pod/perldiag.pod | 11 | ||||
| -rwxr-xr-x | regen/feature.pl | 22 | ||||
| -rw-r--r-- | t/lib/feature/multidimensional | 22 | ||||
| -rw-r--r-- | t/porting/known_pod_issues.dat | 1 |
8 files changed, 166 insertions, 68 deletions
@@ -5586,6 +5586,7 @@ t/lib/feature/bits Tests for feature bit handling t/lib/feature/bundle Tests for feature bundles t/lib/feature/implicit Tests for implicit loading of feature.pm t/lib/feature/indirect Tests for enabling/disabling indirect method calls +t/lib/feature/multidimensional Tests for enabling/disabling $foo{$x, y} => $foo{join($;, $x, $y)} 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 @@ -12,21 +12,22 @@ #define HINT_FEATURE_SHIFT 26 -#define FEATURE_BITWISE_BIT 0x0001 -#define FEATURE___SUB___BIT 0x0002 -#define FEATURE_MYREF_BIT 0x0004 -#define FEATURE_EVALBYTES_BIT 0x0008 -#define FEATURE_FC_BIT 0x0010 -#define FEATURE_INDIRECT_BIT 0x0020 -#define FEATURE_ISA_BIT 0x0040 -#define FEATURE_POSTDEREF_QQ_BIT 0x0080 -#define FEATURE_REFALIASING_BIT 0x0100 -#define FEATURE_SAY_BIT 0x0200 -#define FEATURE_SIGNATURES_BIT 0x0400 -#define FEATURE_STATE_BIT 0x0800 -#define FEATURE_SWITCH_BIT 0x1000 -#define FEATURE_UNIEVAL_BIT 0x2000 -#define FEATURE_UNICODE_BIT 0x4000 +#define FEATURE_BITWISE_BIT 0x0001 +#define FEATURE___SUB___BIT 0x0002 +#define FEATURE_MYREF_BIT 0x0004 +#define FEATURE_EVALBYTES_BIT 0x0008 +#define FEATURE_FC_BIT 0x0010 +#define FEATURE_INDIRECT_BIT 0x0020 +#define FEATURE_ISA_BIT 0x0040 +#define FEATURE_MULTIDIMENSIONAL_BIT 0x0080 +#define FEATURE_POSTDEREF_QQ_BIT 0x0100 +#define FEATURE_REFALIASING_BIT 0x0200 +#define FEATURE_SAY_BIT 0x0400 +#define FEATURE_SIGNATURES_BIT 0x0800 +#define FEATURE_STATE_BIT 0x1000 +#define FEATURE_SWITCH_BIT 0x2000 +#define FEATURE_UNIEVAL_BIT 0x4000 +#define FEATURE_UNICODE_BIT 0x8000 #define FEATURE_BUNDLE_DEFAULT 0 #define FEATURE_BUNDLE_510 1 @@ -46,7 +47,7 @@ ? (PL_curcop->cop_features & (mask)) : FALSE) /* The longest string we pass in. */ -#define MAX_FEATURE_LEN (sizeof("postderef_qq")-1) +#define MAX_FEATURE_LEN (sizeof("multidimensional")-1) #define FEATURE_FC_IS_ENABLED \ ( \ @@ -158,6 +159,13 @@ FEATURE_IS_ENABLED_MASK(FEATURE_UNICODE_BIT)) \ ) +#define FEATURE_MULTIDIMENSIONAL_IS_ENABLED \ + ( \ + CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527 \ + || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ + FEATURE_IS_ENABLED_MASK(FEATURE_MULTIDIMENSIONAL_BIT)) \ + ) + #define SAVEFEATUREBITS() SAVEI32(PL_compiling.cop_features) @@ -265,7 +273,12 @@ S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen, return; case 'm': - if (keylen == sizeof("feature_myref")-1 + if (keylen == sizeof("feature_multidimensional")-1 + && memcmp(subf+1, "ultidimensional", keylen - sizeof("feature_")) == 0) { + mask = FEATURE_MULTIDIMENSIONAL_BIT; + break; + } + else if (keylen == sizeof("feature_myref")-1 && memcmp(subf+1, "yref", keylen - sizeof("feature_")) == 0) { mask = FEATURE_MYREF_BIT; break; diff --git a/lib/feature.pm b/lib/feature.pm index b5ee2eca9b..e14b4c1a64 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -8,31 +8,32 @@ package feature; our $VERSION = '1.60'; our %feature = ( - fc => 'feature_fc', - isa => 'feature_isa', - say => 'feature_say', - state => 'feature_state', - switch => 'feature_switch', - bitwise => 'feature_bitwise', - indirect => 'feature_indirect', - evalbytes => 'feature_evalbytes', - signatures => 'feature_signatures', - current_sub => 'feature___SUB__', - refaliasing => 'feature_refaliasing', - postderef_qq => 'feature_postderef_qq', - unicode_eval => 'feature_unieval', - declared_refs => 'feature_myref', - unicode_strings => 'feature_unicode', + fc => 'feature_fc', + isa => 'feature_isa', + say => 'feature_say', + state => 'feature_state', + switch => 'feature_switch', + bitwise => 'feature_bitwise', + indirect => 'feature_indirect', + evalbytes => 'feature_evalbytes', + signatures => 'feature_signatures', + current_sub => 'feature___SUB__', + refaliasing => 'feature_refaliasing', + postderef_qq => 'feature_postderef_qq', + unicode_eval => 'feature_unieval', + declared_refs => 'feature_myref', + unicode_strings => 'feature_unicode', + multidimensional => 'feature_multidimensional', ); our %feature_bundle = ( - "5.10" => [qw(indirect say state switch)], - "5.11" => [qw(indirect say state switch unicode_strings)], - "5.15" => [qw(current_sub evalbytes fc indirect say state switch unicode_eval unicode_strings)], - "5.23" => [qw(current_sub evalbytes fc indirect postderef_qq say state switch unicode_eval unicode_strings)], - "5.27" => [qw(bitwise current_sub evalbytes fc indirect postderef_qq say state switch unicode_eval unicode_strings)], - "all" => [qw(bitwise current_sub declared_refs evalbytes fc indirect isa postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)], - "default" => [qw(indirect)], + "5.10" => [qw(indirect multidimensional say state switch)], + "5.11" => [qw(indirect multidimensional say state switch unicode_strings)], + "5.15" => [qw(current_sub evalbytes fc indirect multidimensional say state switch unicode_eval unicode_strings)], + "5.23" => [qw(current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)], + "5.27" => [qw(bitwise current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)], + "all" => [qw(bitwise current_sub declared_refs evalbytes fc indirect isa multidimensional postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)], + "default" => [qw(indirect multidimensional)], ); $feature_bundle{"5.12"} = $feature_bundle{"5.11"}; @@ -374,6 +375,23 @@ previous versions, it was simply on all the time. To disallow (or warn on) indirect object syntax on older Perls, see the L<indirect> CPAN module. +=head2 The 'multidimensional' feature + +This feature enables multidimensional array emulation, a perl 4 (or +earlier) feature that was used to emulate multidimensional arrays with +hashes. This works by converting code like C<< $foo{$x, y} >> into +C<< $foo{join($;, $x, $y} >>. It is enabled by default, but can be +turned off to disable multidimensional array emulation. + +When this feature is disabled the syntax that is normally replaced +will report a compilation error. + +This feature is available under this name from Perl 5.34 onwards. In +previous versions, it was simply on all the time. + +You can use the L<multidimensional> module on CPAN to disable +multidimensional array emulation for older versions of Perl. + =head1 FEATURE BUNDLES It's possible to load multiple features together, using @@ -386,49 +404,55 @@ The following feature bundles are available: bundle features included --------- ----------------- - :default indirect + :default indirect multidimensional - :5.10 indirect say state switch + :5.10 indirect multidimensional say state switch - :5.12 indirect say state switch unicode_strings + :5.12 indirect multidimensional say state switch + unicode_strings - :5.14 indirect say state switch unicode_strings + :5.14 indirect multidimensional say state switch + unicode_strings - :5.16 current_sub evalbytes fc indirect say state - switch unicode_eval unicode_strings + :5.16 current_sub evalbytes fc indirect + multidimensional say state switch + unicode_eval unicode_strings - :5.18 current_sub evalbytes fc indirect say state - switch unicode_eval unicode_strings + :5.18 current_sub evalbytes fc indirect + multidimensional say state switch + unicode_eval unicode_strings - :5.20 current_sub evalbytes fc indirect say state - switch unicode_eval unicode_strings + :5.20 current_sub evalbytes fc indirect + multidimensional say state switch + unicode_eval unicode_strings - :5.22 current_sub evalbytes fc indirect say state - switch unicode_eval unicode_strings + :5.22 current_sub evalbytes fc indirect + multidimensional say state switch + unicode_eval unicode_strings :5.24 current_sub evalbytes fc indirect - postderef_qq say state switch unicode_eval - unicode_strings + multidimensional postderef_qq say state + switch unicode_eval unicode_strings :5.26 current_sub evalbytes fc indirect - postderef_qq say state switch unicode_eval - unicode_strings + multidimensional postderef_qq say state + switch unicode_eval unicode_strings :5.28 bitwise current_sub evalbytes fc indirect - postderef_qq say state switch unicode_eval - unicode_strings + multidimensional postderef_qq say state + switch unicode_eval unicode_strings :5.30 bitwise current_sub evalbytes fc indirect - postderef_qq say state switch unicode_eval - unicode_strings + multidimensional postderef_qq say state + switch unicode_eval unicode_strings :5.32 bitwise current_sub evalbytes fc indirect - postderef_qq say state switch unicode_eval - unicode_strings + multidimensional postderef_qq say state + switch unicode_eval unicode_strings :5.34 bitwise current_sub evalbytes fc indirect - postderef_qq say state switch unicode_eval - unicode_strings + multidimensional postderef_qq say state + switch unicode_eval unicode_strings The C<:default> bundle represents the feature set that is enabled before any C<use feature> or C<no feature> declaration. @@ -5967,9 +5967,17 @@ Perl_jmaybe(pTHX_ OP *o) PERL_ARGS_ASSERT_JMAYBE; if (o->op_type == OP_LIST) { - OP * const o2 - = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV))); - o = op_convert_list(OP_JOIN, 0, op_prepend_elem(OP_LIST, o2, o)); + if (FEATURE_MULTIDIMENSIONAL_IS_ENABLED) { + OP * const o2 + = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV))); + o = op_convert_list(OP_JOIN, 0, op_prepend_elem(OP_LIST, o2, o)); + } + else { + /* If the user disables this, then a warning might not be enough to alert + them to a possible change of behaviour here, so throw an exception. + */ + yyerror("Multidimensional hash lookup is disabled"); + } } return o; } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 75fd758cdd..5dc85d0fe5 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3886,6 +3886,17 @@ mutable before freeing the ops. (F) You don't have System V message IPC on your system. +=item Multidimensional hash lookup is disabled + +(F) You supplied a list of subscripts to a hash lookup under +C<< no feature "multidimensional"; >>, eg: + + $z = $foo{$x, $y}; + +which by default acts like: + + $z = $foo{join($;, $x, $y)}; + =item Multidimensional syntax %s not supported (W syntax) Multidimensional arrays aren't written like C<$foo[1,2,3]>. diff --git a/regen/feature.pl b/regen/feature.pl index cab3928f34..fe338fad5c 100755 --- a/regen/feature.pl +++ b/regen/feature.pl @@ -38,6 +38,7 @@ my %feature = ( signatures => 'signatures', isa => 'isa', indirect => 'indirect', + multidimensional => 'multidimensional', ); # NOTE: If a feature is ever enabled in a non-contiguous range of Perl @@ -47,7 +48,7 @@ my %feature = ( # 5.odd implies the next 5.even, but an explicit 5.even can override it. # features bundles -use constant V5_9_5 => sort qw{say state switch indirect}; +use constant V5_9_5 => sort qw{say state switch indirect multidimensional}; use constant V5_11 => sort ( +V5_9_5, qw{unicode_strings} ); use constant V5_15 => sort ( +V5_11, qw{unicode_eval evalbytes current_sub fc} ); use constant V5_23 => sort ( +V5_15, qw{postderef_qq} ); @@ -55,7 +56,7 @@ use constant V5_27 => sort ( +V5_23, qw{bitwise} ); my %feature_bundle = ( all => [ sort keys %feature ], - default => [ qw{indirect} ], + default => [ qw{indirect multidimensional} ], # using 5.9.5 features bundle "5.9.5" => [ +V5_9_5 ], "5.10" => [ +V5_9_5 ], @@ -780,6 +781,23 @@ previous versions, it was simply on all the time. To disallow (or warn on) indirect object syntax on older Perls, see the L<indirect> CPAN module. +=head2 The 'multidimensional' feature + +This feature enables multidimensional array emulation, a perl 4 (or +earlier) feature that was used to emulate multidimensional arrays with +hashes. This works by converting code like C<< $foo{$x, y} >> into +C<< $foo{join($;, $x, $y} >>. It is enabled by default, but can be +turned off to disable multidimensional array emulation. + +When this feature is disabled the syntax that is normally replaced +will report a compilation error. + +This feature is available under this name from Perl 5.34 onwards. In +previous versions, it was simply on all the time. + +You can use the L<multidimensional> module on CPAN to disable +multidimensional array emulation for older versions of Perl. + =head1 FEATURE BUNDLES It's possible to load multiple features together, using diff --git a/t/lib/feature/multidimensional b/t/lib/feature/multidimensional new file mode 100644 index 0000000000..a39baaeec6 --- /dev/null +++ b/t/lib/feature/multidimensional @@ -0,0 +1,22 @@ +Test no feature multidimensional + +__END__ +# NAME simple +my $x = "a"; +my $y = "b"; +my %foo; +$foo{$x, $y} = "c"; +$foo{$y} = "d"; +print $foo{$x, $y}, "\n"; +no feature "multidimensional"; +print $foo{$x, $y}, "\n"; +$foo{$x, $y} = "e"; +print $foo{$y}, "\n"; +use feature "multidimensional"; +print $foo{$x, $y}, "\n"; +$foo{$x, $y} = "e"; +EXPECT +OPTIONS fatal +Multidimensional hash lookup is disabled at - line 8, near "$y}" +Multidimensional hash lookup is disabled at - line 9, near "$y}" +BEGIN not safe after errors--compilation aborted at - line 11. diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index c1c27208b1..21b6091215 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -221,6 +221,7 @@ Moose MRO::Compat msgctl(2) msgget(2) +multidimensional ndbm(3) NgxQueue nl_langinfo(3) |