This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add a default enabled feature "multidimensional"
authorTony Cook <tony@develop-help.com>
Wed, 27 May 2020 00:41:32 +0000 (10:41 +1000)
committerKarl Williamson <khw@cpan.org>
Tue, 11 Aug 2020 04:33:10 +0000 (22:33 -0600)
Like "indirect" this feature is enabled by default and enables the
perl4 hash-based multidimensional array emulation documented under
$; in perlvar.

MANIFEST
feature.h
lib/feature.pm
op.c
pod/perldiag.pod
regen/feature.pl
t/lib/feature/multidimensional [new file with mode: 0644]
t/porting/known_pod_issues.dat

index 8931dd9..7d7e912 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index 2f2f23c..20f7996 100644 (file)
--- a/feature.h
+++ b/feature.h
 
 #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 \
     ( \
         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;
index b5ee2ec..e14b4c1 100644 (file)
@@ -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.
diff --git a/op.c b/op.c
index 8b7f472..05f6d9d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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;
 }
index 75fd758..5dc85d0 100644 (file)
@@ -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]>.
index cab3928..fe338fa 100755 (executable)
@@ -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 (file)
index 0000000..a39baae
--- /dev/null
@@ -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.
index c1c2720..21b6091 100644 (file)
@@ -221,6 +221,7 @@ Moose
 MRO::Compat
 msgctl(2)
 msgget(2)
+multidimensional
 ndbm(3)
 NgxQueue
 nl_langinfo(3)