toke.c: deprecation warning for ' as a package separator

First stage of RFC 0015.

This also changes the warning for ' as package separator in
quoted strings to also be a deprecation warning.

Author: tonycoz

embed.fnc

@@ -3366,7 +3366,8 @@ EXpx	|char * |scan_word	|NN char *s				\
 				|NN char *dest				\
 				|STRLEN destlen 			\
 				|int allow_package			\
-				|NN STRLEN *slp
+				|NN STRLEN *slp 			\
+				|bool warn_tick
 EXpxR	|char * |skipspace_flags|NN char *s				\
 				|U32 flags
 EdXxp	|bool	|validate_proto |NN SV *name				\

embed.h

@@ -1697,7 +1697,7 @@
 #   define reg_temp_copy(a,b)                   Perl_reg_temp_copy(aTHX_ a,b)
 #   define report_uninit(a)                     Perl_report_uninit(aTHX_ a)
 #   define scan_str(a,b,c,d,e)                  Perl_scan_str(aTHX_ a,b,c,d,e)
-#   define scan_word(a,b,c,d,e)                 Perl_scan_word(aTHX_ a,b,c,d,e)
+#   define scan_word(a,b,c,d,e,f)               Perl_scan_word(aTHX_ a,b,c,d,e,f)
 #   define skipspace_flags(a,b)                 Perl_skipspace_flags(aTHX_ a,b)
 #   define sv_magicext_mglob(a)                 Perl_sv_magicext_mglob(aTHX_ a)
 #   define sv_only_taint_gmagic                 Perl_sv_only_taint_gmagic

pod/perldiag.pod

@@ -4517,13 +4517,21 @@ C<sysread()>ing a file, or when seeking past the end of a scalar opened
 for I/O (in anticipation of future reads and to imitate the behavior
 with real files).
 
+=item Old package separator "'" deprecated
+
+(W deprecated, syntax) You used the old package separator "'" in a
+variable, subroutine or package name.  Support for the old package
+separator will be removed in Perl 5.40.
+
 =item Old package separator used in string
 
-(W syntax) You used the old package separator, "'", in a variable
+(W deprecated, syntax) You used the old package separator, "'", in a variable
 named inside a double-quoted string; e.g., C<"In $name's house">.  This
 is equivalent to C<"In $name::s house">.  If you meant the former, put
 a backslash before the apostrophe (C<"In $name\'s house">).
 
+Support for the old package separator will be removed in Perl 5.40.
+
 =item %s() on unopened %s
 
 (W unopened) An I/O operation was attempted on a filehandle that was

proto.h

@@ -1,5 +1,10 @@
 #!./perl
 
+BEGIN {
+    @INC = qw(. ../lib);
+    chdir 't' if -d 't';
+}
+
 print "1..14\n";
 
 $blurfl = 123;
@@ -13,11 +18,14 @@ $bar = 4;
 
 {
     package ABC;
+    no warnings qw(syntax deprecated);
     $blurfl = 5;
     $main'a = $'b;
 }
-
-$ABC'dyick = 6;
+{
+    no warnings qw(syntax deprecated);
+    $ABC'dyick = 6;
+}
 
 $xyz = 2;
 
@@ -28,10 +36,13 @@ $ABC = join(':', sort(keys %ABC::));
 if ('a' lt 'A') {
     print $xyz eq 'bar:main:new:xyz:ABC' ? "ok 1\n" : "not ok 1 '$xyz'\n";
 } else {
-    print $xyz eq 'ABC:bar:main:new:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+    print $xyz eq 'ABC:BEGIN:bar:main:new:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
 }    
-print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
-print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
+print $ABC eq 'BEGIN:blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
+{
+    no warnings qw(syntax deprecated);
+    print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
+}
 
 package ABC;
 

t/comp/package.t

@@ -367,11 +367,14 @@ like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' );
   is(defined &zlonk, '', 'but no body defined');
 }
 
-# [perl #113016] CORE::print::foo
-sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate
-sub CORE'foo'bar { 43 }
-is CORE::print::foo, 43, 'CORE::print::foo is not CORE::print ::foo';
-is scalar eval "CORE::foo'bar", 43, "CORE::foo'bar is not an error";
+{
+    no warnings;
+    # [perl #113016] CORE::print::foo
+    sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate
+    sub CORE'foo'bar { 43 }
+    is CORE::print::foo, 43, 'CORE::print::foo is not CORE::print ::foo';
+    is scalar eval "CORE::foo'bar", 43, "CORE::foo'bar is not an error";
+}
 
 # bug #71748
 eval q{
@@ -448,8 +451,10 @@ END
 eval 's/${<<END}//';
 eval 's//${<<END}/';
 print "ok ", ++$test, " - unterminated here-docs in s/// in string eval\n";
-
-sub 'Hello'_he_said (_);
+{
+    no warnings qw(syntax deprecated);
+    sub 'Hello'_he_said (_);
+}
 is prototype "Hello::_he_said", '_', 'initial tick in sub declaration';
 
 {
@@ -471,11 +476,14 @@ is $pkg, 3, '[perl #114942] for my $foo()){} $foo';
 
 # Check that format 'Foo still works after removing the hack from
 # force_word
-$test++;
-format 'one =
+{
+    no warnings qw(syntax deprecated);
+    $test++;
+    format 'one =
 ok @<< - format 'foo still works
 $test
 .
+}
 {
     local $~ = "one";
     write();

t/comp/parser.t

@@ -416,7 +416,7 @@ use warnings 'syntax';
 () = "$foo'bar";
 () = "@foo'bar";
 () = "$#foo'bar";
-no warnings 'syntax' ;
+no warnings 'syntax', 'deprecated' ;
 () = "$foo'bar";
 () = "@foo'bar";
 () = "$#foo'bar";
@@ -439,7 +439,7 @@ use warnings 'syntax'; use utf8;
 () = "$fooл'barл";
 () = "@fooл'barл";
 () = "$#fooл'barл";
-no warnings 'syntax' ;
+no warnings 'syntax', 'deprecated' ;
 () = "$fooл'barл";
 () = "@fooл'barл";
 () = "$#fooл'barл";
@@ -451,6 +451,19 @@ Old package separator used in string at - line 4.
 Old package separator used in string at - line 5.
 	(Did you mean "$#fooл\'barл" instead?)
 ########
+# NAME deprecation of ' in names
+sub foo'bar { 1 }
+$a'b = 1;
+@a'c = ();
+%a'd = ();
+package a'e;
+EXPECT
+Old package separator "'" deprecated at - line 1.
+Old package separator "'" deprecated at - line 2.
+Old package separator "'" deprecated at - line 3.
+Old package separator "'" deprecated at - line 4.
+Old package separator "'" deprecated at - line 5.
+########
 # toke.c
 use warnings 'ambiguous' ;
 $a = ${time[2]};

t/lib/warnings/toke

@@ -253,7 +253,10 @@ sub OtherSouper::method { "Isidore Ropen, Draft Manager" }
    my @ret = $o->SUPER::method('whatever');
    ::is $ret[0], $o, 'object passed to SUPER::method';
    ::is $ret[1], 'whatever', 'argument passed to SUPER::method';
-   @ret = $o->SUPER'method('whatever');
+   {
+       no warnings qw(syntax deprecated);
+       @ret = $o->SUPER'method('whatever');
+   }
    ::is $ret[0], $o, "object passed to SUPER'method";
    ::is $ret[1], 'whatever', "argument passed to SUPER'method";
    @ret = Saab->SUPER::method;

t/op/method.t

@@ -265,8 +265,10 @@ is (join('', sort values %$anonhash2), 'BARXYZ');
 # Test bless operator.
 
 package MYHASH;
-
-$object = bless $main'anonhash2;
+{
+    no warnings qw(syntax deprecated);
+    $object = bless $main'anonhash2;
+}
 main::is (ref $object, 'MYHASH');
 main::is ($object->{ABC}, 'XYZ');
 
@@ -290,7 +292,10 @@ sub mymethod {
 $string = "bad";
 $object = "foo";
 $string = "good";
-$main'anonhash2 = "foo";
+{
+    no warnings qw(syntax deprecated);
+    $main'anonhash2 = "foo";
+}
 $string = "";
 
 DESTROY {
@@ -307,7 +312,10 @@ package OBJ;
 
 @ISA = ('BASEOBJ');
 
-$main'object = bless {FOO => 'foo', BAR => 'bar'};
+{
+    no warnings qw(syntax deprecated);
+    $main'object = bless {FOO => 'foo', BAR => 'bar'};
+}
 
 package main;
 
@@ -320,10 +328,13 @@ is ($object->doit("BAR"), 'bar');
 $foo = doit $object "FOO";
 main::is ($foo, 'foo');
 
-sub BASEOBJ'doit {
-    local $ref = shift;
-    die "Not an OBJ" unless ref $ref eq 'OBJ';
-    $ref->{shift()};
+{
+    no warnings qw(syntax deprecated);
+    sub BASEOBJ'doit {
+        local $ref = shift;
+        die "Not an OBJ" unless ref $ref eq 'OBJ';
+        $ref->{shift()};
+    }
 }
 
 package UNIVERSAL;

t/op/ref.t

@@ -237,6 +237,7 @@ eval { @b = sort twoface 4,1 };
 cmp_ok(substr($@,0,4), 'eq', 'good', 'twoface eval');
 
 eval <<'CODE';
+    no warnings qw(deprecated syntax);
     my @result = sort main'Backwards 'one', 'two';
 CODE
 cmp_ok($@,'eq','',q(old skool package));

t/op/sort.t

@@ -23,7 +23,7 @@ foreach my $t (@tests) {
     my ( $sub, $name ) = @$t;
 
     fresh_perl_is(
-        qq[sub $sub { print qq[ok\n]} &{"$sub"}; my \$d = defined *{"foo$sub"} ],
+        qq[no warnings qw(syntax deprecated); sub $sub { print qq[ok\n]} &{"$sub"}; my \$d = defined *{"foo$sub"} ],
         q[ok],
         { switches => ['-w'] },
         $name

t/op/stash_parse_gv.t

@@ -34,16 +34,23 @@ ok 1, "sanity check. If we got this far, UTF-8 in package names is legal.";
         $ㄅĽuṞfⳐ = 5;
     }
 
-    $압Ƈ'd읯ⱪ = 6;        #'
-
+    {
+        no warnings qw(syntax deprecated);
+        $압Ƈ'd읯ⱪ = 6;        #'
+    }
+    
     $ꑭʑ = 2;
 
     $ꑭʑ = join(':', sort(keys %ꑭʑ::));
     $압Ƈ = join(':', sort(keys %압Ƈ::));
 
-    ::is $ꑭʑ, 'bar:ニュー:ꑭʑ:압Ƈ', "comp/stash.t test 1";
+    ::is $ꑭʑ, 'BEGIN:bar:ニュー:ꑭʑ:압Ƈ', "comp/stash.t test 1";
     ::is $압Ƈ, "d읯ⱪ:ㄅĽuṞfⳐ", "comp/stash.t test 2";
-    ::is $main'ㄅĽuṞfⳐ, 123, "comp/stash.t test 3";
+
+    {
+        no warnings qw(syntax deprecated);
+        ::is $main'ㄅĽuṞfⳐ, 123, "comp/stash.t test 3";
+    }
 
     package 압Ƈ;
 

t/uni/package.t

@@ -41,6 +41,7 @@ plan (tests => 66880);
     eval q<use strict; ${flark::fleem}>;
     is($@, '', q<${package::var} works>);
 
+    no warnings qw(syntax deprecated);
     local $@;
     eval q<use strict; ${fleem'flark}>;
     is($@, '', q<...as does ${package'var}>);