feature apostrophe_as_package_separator implementation

Author: tonycoz

MANIFEST

@@ -6105,6 +6105,7 @@ t/lib/Devel/switchd_empty.pm		Module for t/run/switchd.t
 t/lib/Devel/switchd_goto.pm		Module for t/run/switchd.t
 t/lib/Dies.pm				For test case in op/require_errors.t
 t/lib/feature/api			Test API for checking features enabled/disabled
+t/lib/feature/apos_as_pack_sep		Tests for enabling/disabling apostrophe_as_package_separator feature
 t/lib/feature/bareword_filehandles	Tests for enabling/disabling bareword_filehandles feature
 t/lib/feature/bits			Tests for feature bit handling
 t/lib/feature/bundle			Tests for feature bundles

embed.fnc

@@ -3018,12 +3018,6 @@ EXpx	|char * |scan_word	|NN char *s				\
 				|STRLEN destlen 			\
 				|int allow_package			\
 				|NN STRLEN *slp
-EXpx	|char * |scan_word6	|NN char *s				\
-				|NN char *dest				\
-				|STRLEN destlen 			\
-				|int allow_package			\
-				|NN STRLEN *slp 			\
-				|bool warn_tick
 Cp	|U32	|seed
 : Only used by perl.c/miniperl.c, but defined in caretx.c
 ep	|void	|set_caret_X
@@ -5909,8 +5903,7 @@ S	|void	|parse_ident	|NN char **s				\
 				|NN char * const e			\
 				|int allow_package			\
 				|bool is_utf8				\
-				|bool check_dollar			\
-				|bool tick_warn
+				|bool check_dollar
 S	|int	|pending_ident
 RS	|char * |scan_const	|NN char *start
 RS	|char * |scan_formline	|NN char *s

embed.h

@@ -1629,7 +1629,7 @@
 #     define intuit_more(a,b)                   S_intuit_more(aTHX_ a,b)
 #     define lop(a,b,c)                         S_lop(aTHX_ a,b,c)
 #     define missingterm(a,b)                   S_missingterm(aTHX_ a,b)
-#     define parse_ident(a,b,c,d,e,f,g)         S_parse_ident(aTHX_ a,b,c,d,e,f,g)
+#     define parse_ident(a,b,c,d,e,f)           S_parse_ident(aTHX_ a,b,c,d,e,f)
 #     define pending_ident()                    S_pending_ident(aTHX)
 #     define scan_const(a)                      S_scan_const(aTHX_ a)
 #     define scan_formline(a)                   S_scan_formline(aTHX_ a)
@@ -1766,7 +1766,6 @@
 #   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_word6(a,b,c,d,e,f)              Perl_scan_word6(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

lib/overload.t

@@ -2395,7 +2395,7 @@ is eval {"$a"}, overload::StrVal($a),
 {
  package mane;
  use overload q\""\ => "bear::strength";
- use overload bool  => "bear'bouillon";
+ use overload bool  => "bear::bouillon";
 }
 @bear::ISA = 'food';
 sub food::strength { 'twine' }

pod/perldata.pod

@@ -136,22 +136,17 @@ generic characters, and identifiers should match
 That is, any word character in the ASCII range, as long as the first
 character is not a digit.
 
-There are two package separators in Perl: A double colon (C<::>) and a single
-quote (C<'>).  Use of C<'> as the package separator is deprecated and will be
-removed in Perl 5.40.  Normal identifiers can start or end with a double
-colon, and can contain several parts delimited by double colons.  Single
-quotes have similar rules, but with the exception that they are not legal at
-the end of an identifier: That is, C<$'foo> and C<$foo'bar> are legal, but
-C<$foo'bar'> is not.
+There is one package separator in Perl: A double colon (C<::>).
+Normal identifiers can start or end with a double colon, and can
+contain several parts delimited by double colons.
+
+Previously you could use C<'> as a package separator, this was removed
+in Perl 5.42.
 
 Additionally, if the identifier is preceded by a sigil --
 that is, if the identifier is part of a variable name -- it
 may optionally be enclosed in braces.
 
-While you can mix double colons with singles quotes, the quotes must come
-after the colons: C<$::::'foo> and C<$foo::'bar> are legal, but C<$::'::foo>
-and C<$foo'::bar> are not.
-
 Put together, a grammar to match a basic identifier becomes
 
  /
@@ -164,9 +159,9 @@ Put together, a grammar to match a basic identifier becomes
           )
       )
       (?<normal_identifier>
-          (?: :: )* '?
+          (?: :: )*
            (?&basic_identifier)
-           (?: (?= (?: :: )+ '? | (?: :: )* ' ) (?&normal_identifier) )?
+           (?: (?= :: ) (?&normal_identifier) )?
           (?: :: )*
       )
       (?<basic_identifier>

proto.h

@@ -1,10 +1,5 @@
 #!./perl
 
-BEGIN {
-    @INC = qw(. ../lib);
-    chdir 't' if -d 't';
-}
-
 print "1..14\n";
 
 $blurfl = 123;
@@ -18,14 +13,10 @@ $bar = 4;
 
 {
     package ABC;
-    no warnings qw(syntax deprecated);
     $blurfl = 5;
     $main'a = $'b;
 }
-{
-    no warnings qw(syntax deprecated);
-    $ABC'dyick = 6;
-}
+$ABC'dyick = 6;
 
 $xyz = 2;
 
@@ -36,13 +27,10 @@ $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:BEGIN:bar:main:new:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\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";
+    print $xyz eq 'ABC: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";
 
 package ABC;
 

t/comp/package.t

@@ -611,3 +611,33 @@ syntax error at - line 2, near "[
 =="
   (Might be a runaway multi-line // string starting on line 1)
 Execution of - aborted due to compilation errors.
+########
+# NAME tick in names: initial character of sub name (reverted)
+sub 'Hello'_he_said (_);
+EXPECT
+OPTIONS nonfatal
+########
+# NAME tick in names: initial character of sub name (no feature)
+no feature 'apostrophe_as_package_separator';
+sub 'Hello'_he_said (_);
+EXPECT
+Illegal declaration of anonymous subroutine at - line 2.
+########
+# NAME tick in names: initial character of format name (reverted)
+    format 'one =
+ok @<< - format 'foo still works
+$test
+.
+EXPECT
+OPTIONS nonfatal
+########
+# NAME tick in names: initial character of format name (no feature_
+no feature 'apostrophe_as_package_separator';
+    format 'one =
+ok @<< - format 'foo still works
+$test
+.
+EXPECT
+syntax error at - line 3, near "ok @<< - format '"
+  (Might be a runaway multi-line '' string starting on line 2)
+Execution of - aborted due to compilation errors.

t/lib/croak/toke

@@ -0,0 +1,34 @@
+Check apostrophe_as_package_separator feature
+
+__END__
+# NAME check default and 5.41 bundle
+$foo'bar = 1;
+use v5.41;
+$foo'bar = 2;
+EXPECT
+OPTIONS fatal
+Global symbol "$foo" requires explicit package name (did you forget to declare "my $foo"?) at - line 3.
+Can't find string terminator "'" anywhere before EOF at - line 3.
+########
+# NAME no feature apostrophe_as_package_separator
+$foo'bar = 1;
+no feature 'apostrophe_as_package_separator';
+$foo'bar = 2;
+EXPECT
+OPTIONS fatal
+Can't find string terminator "'" anywhere before EOF at - line 3.
+########
+# NAME use feature apostrophe_as_package_separator
+use v5.41;
+use feature 'apostrophe_as_package_separator';
+$foo'bar = 2;
+$foo'bar = 3; # suppress used only once
+EXPECT
+########
+# NAME ' in symbolic refs always works and is treated as ::
+my $x = "foo'bar";
+no feature 'apostrophe_as_package_separator';
+$$x = "Hello\n";
+print $foo::bar;
+EXPECT
+Hello

t/lib/feature/apos_as_pack_sep

@@ -407,6 +407,80 @@ no warnings 'syntax' ;
 sort ("")
 EXPECT
 
+########
+@foo::bar = 1..3;
+() = "$foo'bar";
+() = "@foo'bar";
+() = "$#foo'bar";
+use warnings 'syntax';
+() = "$foo'bar";
+() = "@foo'bar";
+() = "$#foo'bar";
+no warnings 'syntax', 'deprecated' ;
+() = "$foo'bar";
+() = "@foo'bar";
+() = "$#foo'bar";
+# ' in names no longer deprecated, ensure we don't warn
+EXPECT
+########
+use warnings 'syntax'; use utf8;
+@fooл::barл = 1..3;
+() = "$fooл'barл";
+() = "@fooл'barл";
+() = "$#fooл'barл";
+no warnings 'syntax', 'deprecated' ;
+() = "$fooл'barл";
+() = "@fooл'barл";
+() = "$#fooл'barл";
+# ' in names no longer deprecated, ensure we don't warn
+EXPECT
+########
+# NAME deprecation of ' in names reverted
+sub foo'bar { 1 }
+$a'b = 1;
+@a'c = ();
+%a'd = ();
+package a'e;
+# ' in names no longer deprecated, ensure we don't warn
+EXPECT
+########
+# NAME ' no longer is part of the symbol character set (reverted)
+# previously these would parse like:
+# "${foo'bar}", but they did parse like "${foo}'bar"
+# but now they parse in names again
+@foo::bar = 1..3;
+() = "$foo'bar";
+() = "@foo'bar";
+() = "$#foo'bar";
+use warnings 'syntax';
+() = "$foo'bar";
+() = "@foo'bar";
+() = "$#foo'bar";
+no warnings 'syntax', 'deprecated' ;
+() = "$foo'bar";
+() = "@foo'bar";
+() = "$#foo'bar";
+EXPECT
+########
+# similar to the test above in that the parsing has changed
+use warnings 'syntax'; use utf8;
+@fooл::barл = 1..3;
+() = "$fooл'barл";
+() = "@fooл'barл";
+() = "$#fooл'barл";
+no warnings 'syntax', 'deprecated' ;
+() = "$fooл'barл";
+() = "@fooл'barл";
+() = "$#fooл'barл";
+EXPECT
+########
+# NAME deprecation of ' in names (reverted)
+sub foo'bar { 1 }
+$a'b = 1;
+@a'c = ();
+%a'd = ();
+package a'e;
+EXPECT
 ########
 # toke.c
 use warnings 'ambiguous' ;