From 8ed9b5d7e45f467581c122d383c4cdc957852fa1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org>
Date: Sat, 10 May 2014 00:04:58 +0100
Subject: [PATCH] Disallow omitting % and @ on hash and array names

Really old Perl let you omit the @ on array names and the % on hash
names in some spots.  This has issued a deprecation warning since Perl
5.0, and is no longer permitted.
---
 op.c              | 38 ++-------------------------------
 pod/perldelta.pod |  6 ++++++
 pod/perldiag.pod  | 10 ---------
 t/lib/croak/op    | 46 ++++++++++++++++++++++++++++++++++++++++
 t/lib/warnings/op | 32 ----------------------------
 t/op/array.t      | 63 +++++++++++++++++++++++++------------------------------
 t/op/each.t       | 21 +------------------
 t/op/push.t       | 14 +------------
 8 files changed, 85 insertions(+), 145 deletions(-)

diff --git a/op.c b/op.c
index 716c684..e462fc5 100644
--- a/op.c
+++ b/op.c
@@ -9149,24 +9149,7 @@ Perl_ck_fun(pTHX_ OP *o)
 				   "Useless use of %s with no values",
 				   PL_op_desc[type]);
 
-		if (kid->op_type == OP_CONST &&
-		    (kid->op_private & OPpCONST_BARE))
-		{
-		    OP * const newop = newAVREF(newGVOP(OP_GV, 0,
-			gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVAV) ));
-		    Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-				   "Array @%"SVf" missing the @ in argument %"IVdf" of %s()",
-				   SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
-#ifdef PERL_MAD
-		    op_getmad(kid,newop,'K');
-#else
-		    op_free(kid);
-#endif
-		    kid = newop;
-		    kid->op_sibling = sibl;
-		    *tokid = kid;
-		}
-		else if (kid->op_type == OP_CONST
+		if (kid->op_type == OP_CONST
 		      && (  !SvROK(cSVOPx_sv(kid)) 
 		         || SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV  )
 		        )
@@ -9184,24 +9167,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		}
 		break;
 	    case OA_HVREF:
-		if (kid->op_type == OP_CONST &&
-		    (kid->op_private & OPpCONST_BARE))
-		{
-		    OP * const newop = newHVREF(newGVOP(OP_GV, 0,
-			gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVHV) ));
-		    Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-				   "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()",
-				   SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
-#ifdef PERL_MAD
-		    op_getmad(kid,newop,'K');
-#else
-		    op_free(kid);
-#endif
-		    kid = newop;
-		    kid->op_sibling = sibl;
-		    *tokid = kid;
-		}
-		else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
+		if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
 		    bad_type_pv(numargs, "hash", PL_op_desc[type], 0, kid);
 		op_lvalue(kid, type);
 		break;
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index c6f06dc..c9c8f79 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -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 Omitting % and @ on hash and array names is no longer permitted
+
+Really old Perl let you omit the @ on array names and the % on hash
+names in some spots.  This has issued a deprecation warning since Perl
+5.0, and is no longer permitted.
+
 =head1 Deprecations
 
 XXX Any deprecated features, syntax, modules etc. should be listed here.
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f87ca9c..d606170 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -186,11 +186,6 @@ point and did not attempt to push this layer.  If your program
 didn't explicitly request the failing operation, it may be the
 result of the value of the environment variable PERLIO.
 
-=item Array @%s missing the @ in argument %d of %s()
-
-(D deprecated) Really old Perl let you omit the @ on array names in some
-spots.  This is now heavily deprecated.
-
 =item A sequence of multiple spaces in a charnames alias definition is deprecated
 
 (D deprecated) You defined a character name which had multiple space
@@ -2171,11 +2166,6 @@ something: a template character or a ()-group.  See L<perlfunc/pack>.
 to have existed already, but for some reason it didn't, and had to be
 created on an emergency basis to prevent a core dump.
 
-=item Hash %%s missing the % in argument %d of %s()
-
-(D deprecated) Really old Perl let you omit the % on hash names in some
-spots.  This is now heavily deprecated.
-
 =item %s has too many errors
 
 (F) The parser has given up trying to parse the program after 10 errors.
diff --git a/t/lib/croak/op b/t/lib/croak/op
index 603f718..d71be34 100644
--- a/t/lib/croak/op
+++ b/t/lib/croak/op
@@ -82,3 +82,49 @@ exists argument is not a HASH or ARRAY element or a subroutine at - line 1.
 exists &foo()
 EXPECT
 exists argument is not a subroutine name at - line 1.
+########
+# NAME push BAREWORD
+no warnings 'experimental';
+push FRED;
+EXPECT
+Type of arg 1 to push must be array (not constant item) at - line 2, near "FRED;"
+Execution of - aborted due to compilation errors.
+########
+# NAME pop BAREWORD
+no warnings 'experimental';
+pop FRED;
+EXPECT
+Type of arg 1 to pop must be array (not constant item) at - line 2, near "FRED;"
+Execution of - aborted due to compilation errors.
+########
+# NAME shift BAREWORD
+no warnings 'experimental';
+shift FRED;
+EXPECT
+Type of arg 1 to shift must be array (not constant item) at - line 2, near "FRED;"
+Execution of - aborted due to compilation errors.
+########
+# NAME unshift BAREWORD
+no warnings 'experimental';
+unshift FRED;
+EXPECT
+Type of arg 1 to unshift must be array (not constant item) at - line 2, near "FRED;"
+Execution of - aborted due to compilation errors.
+########
+# NAME keys BAREWORD
+@a = keys FRED ;
+EXPECT
+Type of arg 1 to keys must be hash (not constant item) at - line 1, near "FRED ;"
+Execution of - aborted due to compilation errors.
+########
+# NAME values BAREWORD
+@a = values FRED ;
+EXPECT
+Type of arg 1 to values must be hash (not constant item) at - line 1, near "FRED ;"
+Execution of - aborted due to compilation errors.
+########
+# NAME each BAREWORD
+@a = each FRED ;
+EXPECT
+Type of arg 1 to each must be hash (not constant item) at - line 1, near "FRED ;"
+Execution of - aborted due to compilation errors.
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index bca2818..f5fad9c 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -61,18 +61,12 @@
        format FRED =
        .
  
-     Array @%s missing the @ in argument %d of %s() 
-	push fred ;
- 
      push on reference is experimental			[ck_fun]
      pop on reference is experimental
      shift on reference is experimental
      unshift on reference is experimental
      splice on reference is experimental
  
-     Hash %%%s missing the %% in argument %d of %s() 
-	keys joe ;
- 
      Statement unlikely to be reached
      	(Maybe you meant system() when you said exec()?
  	exec "true" ; my $a
@@ -235,12 +229,6 @@ my @s = @f{"]", "a"};
 @h{m ""};
 use constant phoo => 1..3;
 @h{+phoo}; # rv2av
-{
-    no warnings 'deprecated';
-    @h{each H};
-    @h{values H};
-    @h{keys H};
-}
 @h{sort foo};
 @h{reverse foo};
 @h{caller 0};
@@ -284,12 +272,6 @@ my @s = @f["]", "a"];
 @h[m ""];
 use constant phoo => 1..3;
 @h[+phoo]; # rv2av
-{
-    no warnings 'deprecated';
-    @h[each H];
-    @h[values H];
-    @h[keys H];
-}
 @h[sort foo];
 @h[reverse foo];
 @h[caller 0];
@@ -1025,13 +1007,6 @@ format FRED =
 EXPECT
 Format FRED redefined at - line 5.
 ########
-# op.c
-push FRED;
-no warnings 'deprecated' ;
-push FRED;
-EXPECT
-Array @FRED missing the @ in argument 1 of push() at - line 2.
-########
 # op.c [Perl_ck_fun]
 $fred = [];
 push $fred;
@@ -1053,13 +1028,6 @@ unshift on reference is experimental at - line 6.
 splice on reference is experimental at - line 7.
 ########
 # op.c
-@a = keys FRED ;
-no warnings 'deprecated' ;
-@a = keys FRED ;
-EXPECT
-Hash %FRED missing the % in argument 1 of keys() at - line 2.
-########
-# op.c
 use warnings 'exec' ;
 exec "$^X -e 1" ; 
 my $a
diff --git a/t/op/array.t b/t/op/array.t
index 7486808..bc5c096 100644
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 
-plan (171);
+plan (170);
 
 #
 # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -100,32 +100,27 @@ is($foo, 'e');
 $foo = ('a','b','c','d','e','f')[1];
 is($foo, 'b');
 
-@foo = ( 'foo', 'bar', 'burbl');
-{
-    no warnings 'deprecated';
-    push(foo, 'blah');
-}
-is($#foo, 3);
+@foo = ( 'foo', 'bar', 'burbl', 'blah');
 
 # various AASSIGN_COMMON checks (see newASSIGNOP() in op.c)
 
-#curr_test(38);
+#curr_test(37);
 
 @foo = @foo;
-is("@foo", "foo bar burbl blah");				# 38
+is("@foo", "foo bar burbl blah");				# 37
 
 (undef,@foo) = @foo;
-is("@foo", "bar burbl blah");					# 39
+is("@foo", "bar burbl blah");					# 38
 
 @foo = ('XXX',@foo, 'YYY');
-is("@foo", "XXX bar burbl blah YYY");				# 40
+is("@foo", "XXX bar burbl blah YYY");				# 39
 
 @foo = @foo = qw(foo b\a\r bu\\rbl blah);
-is("@foo", 'foo b\a\r bu\\rbl blah');				# 41
+is("@foo", 'foo b\a\r bu\\rbl blah');				# 40
 
-@bar = @foo = qw(foo bar);					# 42
+@bar = @foo = qw(foo bar);					# 41
 is("@foo", "foo bar");
-is("@bar", "foo bar");						# 43
+is("@bar", "foo bar");						# 42
 
 # try the same with local
 # XXX tie-stdarray fails the tests involving local, so we use
@@ -135,55 +130,55 @@ is("@bar", "foo bar");						# 43
 {
 
     local @bee = @bee;
-    is("@bee", "foo bar burbl blah");				# 44
+    is("@bee", "foo bar burbl blah");				# 43
     {
 	local (undef,@bee) = @bee;
-	is("@bee", "bar burbl blah");				# 45
+	is("@bee", "bar burbl blah");				# 44
 	{
 	    local @bee = ('XXX',@bee,'YYY');
-	    is("@bee", "XXX bar burbl blah YYY");		# 46
+	    is("@bee", "XXX bar burbl blah YYY");		# 45
 	    {
 		local @bee = local(@bee) = qw(foo bar burbl blah);
-		is("@bee", "foo bar burbl blah");		# 47
+		is("@bee", "foo bar burbl blah");		# 46
 		{
 		    local (@bim) = local(@bee) = qw(foo bar);
-		    is("@bee", "foo bar");			# 48
-		    is("@bim", "foo bar");			# 49
+		    is("@bee", "foo bar");			# 47
+		    is("@bim", "foo bar");			# 48
 		}
-		is("@bee", "foo bar burbl blah");		# 50
+		is("@bee", "foo bar burbl blah");		# 49
 	    }
-	    is("@bee", "XXX bar burbl blah YYY");		# 51
+	    is("@bee", "XXX bar burbl blah YYY");		# 50
 	}
-	is("@bee", "bar burbl blah");				# 52
+	is("@bee", "bar burbl blah");				# 51
     }
-    is("@bee", "foo bar burbl blah");				# 53
+    is("@bee", "foo bar burbl blah");				# 52
 }
 
 # try the same with my
 {
     my @bee = @bee;
-    is("@bee", "foo bar burbl blah");				# 54
+    is("@bee", "foo bar burbl blah");				# 53
     {
 	my (undef,@bee) = @bee;
-	is("@bee", "bar burbl blah");				# 55
+	is("@bee", "bar burbl blah");				# 54
 	{
 	    my @bee = ('XXX',@bee,'YYY');
-	    is("@bee", "XXX bar burbl blah YYY");		# 56
+	    is("@bee", "XXX bar burbl blah YYY");		# 55
 	    {
 		my @bee = my @bee = qw(foo bar burbl blah);
-		is("@bee", "foo bar burbl blah");		# 57
+		is("@bee", "foo bar burbl blah");		# 56
 		{
 		    my (@bim) = my(@bee) = qw(foo bar);
-		    is("@bee", "foo bar");			# 58
-		    is("@bim", "foo bar");			# 59
+		    is("@bee", "foo bar");			# 57
+		    is("@bim", "foo bar");			# 58
 		}
-		is("@bee", "foo bar burbl blah");		# 60
+		is("@bee", "foo bar burbl blah");		# 59
 	    }
-	    is("@bee", "XXX bar burbl blah YYY");		# 61
+	    is("@bee", "XXX bar burbl blah YYY");		# 60
 	}
-	is("@bee", "bar burbl blah");				# 62
+	is("@bee", "bar burbl blah");				# 61
     }
-    is("@bee", "foo bar burbl blah");				# 63
+    is("@bee", "foo bar burbl blah");				# 62
 }
 
 # try the same with our (except that previous values aren't restored)
diff --git a/t/op/each.t b/t/op/each.t
index be8aa48..4cfc03a 100644
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 59;
+plan tests => 57;
 
 $h{'abc'} = 'ABC';
 $h{'def'} = 'DEF';
@@ -106,25 +106,6 @@ isnt ($size, (split('/', scalar %hash))[1]);
 
 is (keys(%hash), 10, "keys (%hash)");
 
-{
-    no warnings 'deprecated';
-    is (keys(hash), 10, "keys (hash)");
-}
-
-$i = 0;
-%h = (a => A, b => B, c=> C, d => D, abc => ABC);
-{
-    no warnings 'deprecated';
-    @keys = keys(h);
-    @values = values(h);
-    while (($key, $value) = each(h)) {
-	if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-		$i++;
-	}
-    }
-}
-is ($i, 5);
-
 @tests = (&next_test, &next_test, &next_test);
 {
     package Obj;
diff --git a/t/op/push.t b/t/op/push.t
index b473322..409920a 100644
--- a/t/op/push.t
+++ b/t/op/push.t
@@ -20,7 +20,7 @@ BEGIN {
 -4,			4 5 6 7,	0 1 2 3
 EOF
 
-plan tests => 16 + @tests*4;
+plan tests => 14 + @tests*4;
 die "blech" unless @tests;
 
 @x = (1,2,3);
@@ -29,18 +29,6 @@ is( join(':',@x), '1:2:3:1:2:3', 'push array onto array');
 push(@x,4);
 is( join(':',@x), '1:2:3:1:2:3:4', 'push integer onto array');
 
-# test for push/pop intuiting @ on array
-{
-    no warnings 'deprecated';
-    push(x,3);
-}
-is( join(':',@x), '1:2:3:1:2:3:4:3', 'push intuiting @ on array');
-{
-    no warnings 'deprecated';
-    pop(x);
-}
-is( join(':',@x), '1:2:3:1:2:3:4', 'pop intuiting @ on array');
-
 no warnings 'experimental::autoderef';
 
 # test for push/pop on arrayref
-- 
1.9.1