Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

forbid empty parts in package names #12839

Open
p5pRT opened this issue Mar 7, 2013 · 23 comments
Open

forbid empty parts in package names #12839

p5pRT opened this issue Mar 7, 2013 · 23 comments
Labels
distro-All hasPatch type-core

Comments

@p5pRT
Copy link

p5pRT commented Mar 7, 2013

Migrated from rt.perl.org#117087 (status was 'open')

Searchable as RT117087$
@p5pRT
Copy link
Author

p5pRT commented Mar 7, 2013

From @rjbs

These package names are all condemned, to be forbidden in perl 5.20 or possibly
perl 5.22.

  package :​:X
  package X​::
  package X​::​::Y

...and especially​:

  package :​:

Similarly any package names which use ' to similar effect. The removal of the
package separator ' from perl is out of scope for this ticket.

--
rjbs

@p5pRT
Copy link
Author

p5pRT commented Mar 7, 2013

From ambrus@math.bme.hu

On 3/7/13, Ricardo SIGNES <perlbug-followup@​perl.org> wrote​:

These package names are all condemned, to be forbidden in perl 5.20 or
possibly perl 5.22.

package :​:X

Would this forbid "​::X" as a package name string too? Currently "​::X"
is a synonym to "main​::X", which differs from "X" in that when you
call a method on the string it will check *main​::X{IO} instead of
*X{IO} in the current package.

Ambrus

@p5pRT
Copy link
Author

p5pRT commented Mar 7, 2013

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Mar 7, 2013

From @Hugmeir

On Thu, Mar 7, 2013 at 6​:18 PM, Zsbán Ambrus <ambrus@​math.bme.hu> wrote​:

On 3/7/13, Ricardo SIGNES <perlbug-followup@​perl.org> wrote​:

These package names are all condemned, to be forbidden in perl 5.20 or
possibly perl 5.22.

package :​:X

Would this forbid "​::X" as a package name string too? Currently "​::X"
is a synonym to "main​::X", which differs from "X" in that when you
call a method on the string it will check *main​::X{IO} instead of
*X{IO} in the current package.

Ambrus

I'm wondering the same thing. Unlike foo​::​::bar or foo​::, :​:foo
actually has a documented meaning. I don't think this should be
deprecated.
The rest can rot though.

@p5pRT
Copy link
Author

p5pRT commented Mar 7, 2013

From @doy

On Thu, Mar 07, 2013 at 06​:36​:39PM -0300, Brian Fraser wrote​:

On Thu, Mar 7, 2013 at 6​:18 PM, Zsbán Ambrus <ambrus@​math.bme.hu> wrote​:

On 3/7/13, Ricardo SIGNES <perlbug-followup@​perl.org> wrote​:

These package names are all condemned, to be forbidden in perl 5.20 or
possibly perl 5.22.

package :​:X

Would this forbid "​::X" as a package name string too? Currently "​::X"
is a synonym to "main​::X", which differs from "X" in that when you
call a method on the string it will check *main​::X{IO} instead of
*X{IO} in the current package.

Ambrus

I'm wondering the same thing. Unlike foo​::​::bar or foo​::, :​:foo
actually has a documented meaning. I don't think this should be
deprecated.
The rest can rot though.

Foo​:: has a documented meaning too - it's a form of quoting, so that
Foo​::->new always means "Foo"->new, and never Foo()->new (which is the
default interpretation of Foo->new).

That said, I'm fairly sure that all of these forms are only being
deprecated in package statements - I don't see any reason why
"package :​:X" or "package X​::" are reasonable things to do.

-doy

@p5pRT
Copy link
Author

p5pRT commented Mar 8, 2013

From @rjbs

* Jesse Luehrs <doy@​tozt.net> [2013-03-07T16​:42​:45]

Foo​:: has a documented meaning too - it's a form of quoting, so that
Foo​::->new always means "Foo"->new, and never Foo()->new (which is the
default interpretation of Foo->new).

That said, I'm fairly sure that all of these forms are only being
deprecated in package statements - I don't see any reason why
"package :​:X" or "package X​::" are reasonable things to do.

More importantly, in package names, even if the practical effect is largely
through the "package" statement. It doesn't affect the meaning of $​::x or
Foo​::

$x​::​::y is right out, though.

--
rjbs

@p5pRT
Copy link
Author

p5pRT commented Mar 15, 2013

From @Hugmeir

On Fri, Mar 8, 2013 at 1​:28 AM, Ricardo Signes
<perl.p5p@​rjbs.manxome.org> wrote​:

* Jesse Luehrs <doy@​tozt.net> [2013-03-07T16​:42​:45]

Foo​:: has a documented meaning too - it's a form of quoting, so that
Foo​::->new always means "Foo"->new, and never Foo()->new (which is the
default interpretation of Foo->new).

That said, I'm fairly sure that all of these forms are only being
deprecated in package statements - I don't see any reason why
"package :​:X" or "package X​::" are reasonable things to do.

More importantly, in package names, even if the practical effect is largely
through the "package" statement. It doesn't affect the meaning of $​::x or
Foo​::

$x​::​::y is right out, though.

--
rjbs

https://github.com/Hugmeir/utf8mess/tree/deprecate_weird_package_separators

That branch introduces four new warnings/deprecations​:

* Use of empty package names is deprecated
package :​:; sub :​:; sub foo​::​::bar; $foo​::​::bar; $foo​::'bar; :​::​:foo;

* Use of trailing double colons in sub or package declaration is deprecated
package foo​::; sub foo​::;

Use of leading double colons in package declarations is deprecated
package :​:foo;

Use of leading double colons in barewords is deprecated
say STDOUT :​:foo; # assuming main​::foo isn't a subroutine and strict
isn't enabled.

That being said, the implementation for the 'package ...;' warnings is
pretty icky, as it replies on an implementation detail​: forced_word()
internally calls scan_word(), saving the identifier in PL_tokenbuf, so
we can check that afterwards. I assume that's safe for the time being?
The alternative is inlining the parts of force_word that we need in
the KEY_package case, but that seemed a needless forward-incompatible
hassle for just a deprecation warning.

@p5pRT
Copy link
Author

p5pRT commented May 26, 2013

From @cpansprout

On Thu Mar 07 20​:29​:25 2013, perl.p5p@​rjbs.manxome.org wrote​:

* Jesse Luehrs <doy@​tozt.net> [2013-03-07T16​:42​:45]

Foo​:: has a documented meaning too - it's a form of quoting, so that
Foo​::->new always means "Foo"->new, and never Foo()->new (which is the
default interpretation of Foo->new).

That said, I'm fairly sure that all of these forms are only being
deprecated in package statements - I don't see any reason why
"package :​:X" or "package X​::" are reasonable things to do.

More importantly, in package names, even if the practical effect is
largely
through the "package" statement. It doesn't affect the meaning of $​::x or
Foo​::

$x​::​::y is right out, though.

But why? Is it harmful? I actually find $x​::​::y useful, as ‘use
Foo​::​::Bar’ vs ‘use Foo​::Bar’ actually lets me have two separate import
subs in the same module.

It may be uncommon, but I have actual code using that.

Also, arbitrary string are currently allowed for ${"..."}. I hope
*that* doesn’t change!

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Jul 16, 2013

From @tonycoz

On Fri Mar 15 12​:08​:41 2013, Hugmeir wrote​:

https://github.com/Hugmeir/utf8mess/tree/deprecate_weird_package_separators

It produces strange test output from lex.t​:

ok 55
ok 56
ok $test - heredoc after "" in s/// in eval
ok $test - heredoc in "" in multiline s///e in eval
ok 59 - null on same line as heredoc in s/// in eval
ok 60 - heredoc in "" in single-line s///e in eval
ok 61 - heredoc in "" in multiline s///e outside eval

Removing the \ from the <<\END in each test fixes that, but I'm not sure
if it then continues to test what was intended.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 1, 2013

From @tonycoz

On Mon Jul 15 18​:12​:31 2013, tonyc wrote​:

On Fri Mar 15 12​:08​:41 2013, Hugmeir wrote​:

https://github.com/Hugmeir/utf8mess/tree/deprecate_weird_package_separators

It produces strange test output from lex.t​:

ok 55
ok 56
ok $test - heredoc after "" in s/// in eval
ok $test - heredoc in "" in multiline s///e in eval
ok 59 - null on same line as heredoc in s/// in eval
ok 60 - heredoc in "" in single-line s///e in eval
ok 61 - heredoc in "" in multiline s///e outside eval

Removing the \ from the <<\END in each test fixes that, but I'm not sure
if it then continues to test what was intended.

I've attached the rebased patches, but the final patch is obviously
incomplete.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 1, 2013

From @tonycoz

0003-Deprecate-leading-double-colons-in-package-declarati.patch 
From 0c478638614160fc9343d547f1c44f11363e4019 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Fri, 15 Mar 2013 15:33:17 -0300
Subject: [PATCH 3/4] Deprecate leading double colons in package declarations
 and barewords

---
 t/lib/warnings/toke |   24 ++++++++++++++++++++++++
 toke.c              |   11 ++++++++++-
 2 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 645de80..4aa391a 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1459,3 +1459,27 @@ no warnings 'deprecated';
 package foo::;
 sub foo::;
 EXPECT
+########
+# toke.c
+package ::foo;
+sub ::foo;
+
+::IO::Handle->can("can");
+$::foo{foo};
+print STDOUT ::doof;
+
+EXPECT
+Use of leading double colons in package declarations is deprecated at - line 2.
+Use of leading double colons in barewords is deprecated at - line 7.
+::doof
+########
+# toke.c
+no warnings 'deprecated';
+package ::foo;
+sub ::foo;
+
+::IO::Handle->can("can");
+$::foo{foo};
+print STDOUT ::doof;
+EXPECT
+::doof
diff --git a/toke.c b/toke.c
index 7b181c9..2f32060 100644
--- a/toke.c
+++ b/toke.c
@@ -7564,7 +7564,13 @@ Perl_yylex(pTHX)
 		    pl_yylval.opval->op_private |= OPpCONST_STRICT;
 		else {
 		bareword:
-		    deprecate_trailing_colons(PL_tokenbuf, strlen(PL_tokenbuf));
+                {
+                    STRLEN tmplen = strlen(PL_tokenbuf);
+                    deprecate_trailing_colons(PL_tokenbuf, tmplen);
+                    if ( tmplen >= 3 && s[0] == ':' && s[1] == ':' && s[2] != ':' ) {
+                        deprecate("leading double colons in barewords");
+                    }
+                }
 		    /* after "print" and similar functions (corresponding to
 		     * "F? L" in opcode.pl), whatever wasn't already parsed as
 		     * a filehandle should be subject to "strict subs".
@@ -8369,6 +8375,9 @@ Perl_yylex(pTHX)
         */
        len = strlen(PL_tokenbuf);
        deprecate_trailing_colons(PL_tokenbuf, len);
+       if ( len >= 3 && PL_tokenbuf[0] == ':' && PL_tokenbuf[1] == ':' && PL_tokenbuf[2] != ':' ) {
+           deprecate("leading double colons in package declarations");
+       }
 	    s = SKIPSPACE1(s);
 	    s = force_strict_version(s);
 	    PL_lex_expect = XBLOCK;
-- 
1.7.10.4

@p5pRT
Copy link
Author

p5pRT commented Aug 1, 2013

From @tonycoz

0002-Stop-t-base-lex.t-from-warning.patch 
From 14233ac66a55137ef20996da98e175f745f0b578 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Fri, 15 Mar 2013 14:43:39 -0300
Subject: [PATCH 2/4] Stop t/base/lex.t from warning

---
 t/base/lex.t |  126 +++++++++++++++++++++++++++++++++++++---------------------
 t/op/sub.t   |    7 +++-
 2 files changed, 87 insertions(+), 46 deletions(-)

diff --git a/t/base/lex.t b/t/base/lex.t
index 7821e76..f023e57 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..94\n";
+print "1..96\n";
 
 $x = 'x';
 
@@ -262,9 +262,6 @@ print ((exists $str{foo}      ? "" : "not ")."ok $test\n"); ++$test;
 print ((exists $str{bar}      ? "" : "not ")."ok $test\n"); ++$test;
 print ((exists $str{xyz::bar} ? "" : "not ")."ok $test\n"); ++$test;
 
-sub foo::::::bar { print "ok $test\n"; $test++ }
-foo::::::bar;
-
 eval "\$x =\xE2foo";
 if ($@ =~ /Unrecognized character \\xE2; marked by <-- HERE after \$x =<-- HERE near column 5/) { print "ok $test\n"; } else { print "not ok $test\n"; }
 $test++;
@@ -272,108 +269,126 @@ $test++;
 # Is "[~" scanned correctly?
 @a = (1,2,3);
 print "not " unless($a[~~2] == 3);
-print "ok 57\n";
+print "ok $test\n";
+$test++;
 
 $_ = "";
-eval 's/(?:)/"${\q||}".<<\END/e;
-ok 58 - heredoc after "" in s/// in eval
+eval 's/(?:)/"${\q||}".<<END/e;
+ok $test - heredoc after "" in s/// in eval
 END
 ';
-print $_ || "not ok 58\n";
+print $_ || "not ok $test\n";
+$test++;
 
 $_ = "";
-eval 's|(?:)|"${\<<\END}"
-ok 59 - heredoc in "" in multiline s///e in eval
+eval 's|(?:)|"${\<<END}"
+ok $test - heredoc in "" in multiline s///e in eval
 END
 |e
 ';
-print $_ || "not ok 59\n";
+print $_ || "not ok $test\n";
+$test++;
 
 $_ = "";
 eval "s/(?:)/<<foo/e #\0
-ok 60 - null on same line as heredoc in s/// in eval
+ok $test - null on same line as heredoc in s/// in eval
 foo
 ";
-print $_ || "not ok 60\n";
+print $_ || "not ok $test\n";
+$test++;
 
 $_ = "";
 eval ' s/(?:)/"${\<<END}"/e;
-ok 61 - heredoc in "" in single-line s///e in eval
+ok $test - heredoc in "" in single-line s///e in eval
 END
 ';
-print $_ || "not ok 61\n";
+print $_ || "not ok $test\n";
+$test++;
 
 $_ = "";
 s|(?:)|"${\<<END}"
-ok 62 - heredoc in "" in multiline s///e outside eval
+ok $test - heredoc in "" in multiline s///e outside eval
 END
 |e;
-print $_ || "not ok 62\n";
+print $_ || "not ok $test\n";
+$test++;
 
-$_ = "not ok 63 - s/// in s/// pattern\n";
+$_ = "not ok $test - s/// in s/// pattern\n";
 s/${s|||;\""}not //;
 print;
+$test++;
 
 /(?{print <<END
-ok 64 - here-doc in re-eval
+ok $test - here-doc in re-eval
 END
 })/;
+$test++;
 
 eval '/(?{print <<END
-ok 65 - here-doc in re-eval in string eval
+ok $test - here-doc in re-eval in string eval
 END
 })/';
+$test++;
 
-eval 'print qq ;ok 66 - eval ending with semicolon\n;'
-  or print "not ok 66 - eval ending with semicolon\n";
+eval 'print qq ;ok $test - eval ending with semicolon\n;'
+  or print "not ok $test - eval ending with semicolon\n";
+$test++;
 
 print "not " unless qr/(?{<<END})/ eq '(?^:(?{<<END}))';
 foo
 END
-print "ok 67 - here-doc in single-line re-eval\n";
+print "ok $test - here-doc in single-line re-eval\n";
+$test++;
 
 $_ = qr/(?{"${<<END}"
 foo
 END
 })/;
 print "not " unless /foo/;
-print "ok 68 - here-doc in quotes in multiline re-eval\n";
+print "ok $test - here-doc in quotes in multiline re-eval\n";
+$test++;
 
 eval 's//<<END/e if 0; $_ = "a
 END
 b"';
 print "not " if $_ =~ /\n\n/;
-print "ok 69 - eval 's//<<END/' does not leave extra newlines\n";
+print "ok $test - eval 's//<<END/' does not leave extra newlines\n";
+$test++;
 
 $_ = a;
 eval "s/a/'b\0'#/e";
 print 'not ' unless $_ eq "b\0";
-print "ok 70 - # after null in s/// repl\n";
+print "ok $test - # after null in s/// repl\n";
+$test++;
 
 s//"#" . <<END/e;
 foo
 END
-print "ok 71 - s//'#' . <<END/e\n";
+print "ok $test - s//'#' . <<END/e\n";
+$test++;
 
 eval "s//3}->{3/e";
 print "not " unless $@;
-print "ok 72 - s//3}->{3/e\n";
+print "ok $test - s//3}->{3/e\n";
+$test++;
 
-$_ = "not ok 73";
+$_ = "not ok $test";
 $x{3} = "not ";
 eval 's/${\%x}{3}//e';
 print "$_ - s//\${\\%x}{3}/e\n";
+$test++;
 
 eval 's/${foo#}//e';
 print "not " unless $@;
-print "ok 74 - s/\${foo#}//e\n";
+print "ok $test - s/\${foo#}//e\n";
+$test++;
 
 eval 'warn ({$_ => 1} + 1) if 0';
 print "not " if $@;
-print "ok 75 - listop({$_ => 1} + 1)\n";
+print "ok $test - listop({$_ => 1} + 1)\n";
 print "# $@" if $@;
+$test++;
 
-$test = 76;
 for(qw< require goto last next redo dump >) {
     eval "sub { $_ foo << 2 }";
     print "not " if $@;
@@ -385,65 +400,86 @@ for(qw< require goto last next redo dump >) {
 my $counter = 0;
 eval 'v23: $counter++; goto v23 unless $counter == 2';
 print "not " unless $counter == 2;
-print "ok 82 - Use v[0-9]+ as a label\n";
+print "ok $test - Use v[0-9]+ as a label\n";
+$test++;
 $counter = 0;
 eval 'v23 : $counter++; goto v23 unless $counter == 2';
 print "not " unless $counter == 2;
-print "ok 83 - Use v[0-9]+ as a label with space before colon\n";
+print "ok $test - Use v[0-9]+ as a label with space before colon\n";
+$test++;
  
 my $output = "";
 eval "package v10::foo; sub test2 { return 'v10::foo' }
       package v10; sub test { return v10::foo::test2(); }
       package main; \$output = v10::test(); "; 
 print "not " unless $output eq 'v10::foo';
-print "ok 84 - call a function in package v10::foo\n";
+print "ok $test - call a function in package v10::foo\n";
+$test++;
 
 print "not " unless (1?v65:"bar") eq 'A';
-print "ok 85 - colon detection after vstring does not break ? vstring :\n";
+
+print "ok $test - colon detection after vstring does not break ? vstring :\n";
+$test++;
 
 # Test pyoq ops with comments before the first delim
 q # comment
  "b"#
   eq 'b' or print "not ";
-print "ok 86 - q <comment> <newline> ...\n";
+print "ok $test - q <comment> <newline> ...\n";
+$text++
 qq # comment
  "b"#
   eq 'b' or print "not ";
-print "ok 87 - qq <comment> <newline> ...\n";
+print "ok $test - qq <comment> <newline> ...\n";
+$test++
 qw # comment
  "b"#
   [0] eq 'b' or print "not ";
-print "ok 88 - qw <comment> <newline> ...\n";
+print "ok $test - qw <comment> <newline> ...\n";
+$test++
 "b" =~ m # comment
  "b"#
    or print "not ";
-print "ok 89 - m <comment> <newline> ...\n";
+print "ok $test - m <comment> <newline> ...\n";
+$test++
 qr # comment
  "b"#
    eq qr/b/ or print "not ";
-print "ok 90 - qr <comment> <newline> ...\n";
+print "ok $test - qr <comment> <newline> ...\n";
+$test++;
 $_ = "a";
 s # comment
  [a] #
  [b] #
  ;
 print "not " unless $_ eq 'b';
-print "ok 91 - s <comment> <newline> ...\n";
+print "ok $test - s <comment> <newline> ...\n";
+$test++;
 $_ = "a";
 tr # comment
  [a] #
  [b] #
  ;
 print "not " unless $_ eq 'b';
-print "ok 92 - tr <comment> <newline> ...\n";
+print "ok $test - tr <comment> <newline> ...\n";
+$test++;
 $_ = "a";
 y # comment
  [a] #
  [b] #
  ;
 print "not " unless $_ eq 'b';
-print "ok 93 - y <comment> <newline> ...\n";
+print "ok $test - y <comment> <newline> ...\n";
+$test++;
 
 print "not " unless (time
                      =>) eq time=>;
-print "ok 94 - => quotes keywords across lines\n";
+print "ok $test - => quotes keywords across lines\n";
+$test++;
+
+print "ok $test - y <comment> <newline> ...\n";
+$test++;
+
+print "ok $test - colon detection after vstring does not break ? vstring :\n";
+$test++;
+
diff --git a/t/op/sub.t b/t/op/sub.t
index fc04ac8..fcd6f97 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 27 );
+plan( tests => 28 );
 
 sub empty_sub {}
 
@@ -165,3 +165,8 @@ is eval {
     is $w, undef,
       '*keyword = sub():method{$y} does not cause ambiguity warnings';
 }
+{
+    no warnings 'deprecated';
+    sub foo::::::bar { ok(1, "sub foo::::bar {} foo::::bar() works") }
+    foo::::::bar;
+}
-- 
1.7.10.4

@p5pRT
Copy link
Author

p5pRT commented Aug 1, 2013

From @tonycoz

0001-Deprecate-empty-package-names-and-trailing-double-co.patch 
From 556ffc5caa10d798783db43dcc660e2c1c6aba87 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Thu, 14 Mar 2013 22:16:15 -0300
Subject: [PATCH 1/4] Deprecate empty package names and trailing double
 colons.

This commit adds two new deprecations:
* Use of empty package names is deprecated
Triggered by things like sub foo::::bar, $foo::::::bar,
or package foo::'bar, or sub ::;

* Use of trailing double colons in sub or package declaration is deprecated
Triggered by package foo::; and sub foo::;
---
 dist/B-Deparse/t/deparse.t |    2 ++
 embed.fnc                  |    2 ++
 embed.h                    |    2 ++
 proto.h                    |    2 ++
 t/lib/warnings/toke        |   39 ++++++++++++++++++++++++++++++++++++++
 t/op/method.t              |    3 +++
 t/op/stash.t               |    1 +
 t/run/switchd.t            |    2 +-
 t/uni/stash.t              |    1 +
 toke.c                     |   45 ++++++++++++++++++++++++++++++++++++++++++--
 10 files changed, 96 insertions(+), 3 deletions(-)

diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 5087485..8bb6891 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -176,6 +176,7 @@ EOFCODE
 # Exotic sub declarations
 $a = `$^X $path "-MO=Deparse" -e "sub ::::{}sub ::::::{}" 2>&1`;
 $a =~ s/-e syntax OK\n//g;
+$a =~ s/Use of empty package.+\n//g;
 is($a, <<'EOCODG', "sub :::: and sub ::::::");
 sub :::: {
     
@@ -458,6 +459,7 @@ my $f = sub {
 '::::'->();
 ####
 # bug #43010
+no warnings;
 &::::;
 ####
 # [perl #77172]
diff --git a/embed.fnc b/embed.fnc
index e4cb24d..bd72158 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2251,6 +2251,8 @@ so	|SV*	|new_constant	|NULLOK const char *s|STRLEN len \
 				|NULLOK SV *pv|NULLOK const char *type \
 				|STRLEN typelen
 s	|int	|deprecate_commaless_var_list
+s  |void  |deprecate_empty_packages|NULLOK char *s
+s  |void  |deprecate_trailing_colons|NULLOK char *s|STRLEN len
 s	|int	|ao		|int toketype
 s  |void|parse_ident|NN char **s|NN char **d \
                      |NN char * const e|int allow_package \
diff --git a/embed.h b/embed.h
index 94f4c15..e4b58dd 100644
--- a/embed.h
+++ b/embed.h
@@ -1598,6 +1598,8 @@
 #define check_uni()		S_check_uni(aTHX)
 #define checkcomma(a,b,c)	S_checkcomma(aTHX_ a,b,c)
 #define deprecate_commaless_var_list()	S_deprecate_commaless_var_list(aTHX)
+#define deprecate_empty_packages(a)	S_deprecate_empty_packages(aTHX_ a)
+#define deprecate_trailing_colons(a,b)	S_deprecate_trailing_colons(aTHX_ a,b)
 #define filter_gets(a,b)	S_filter_gets(aTHX_ a,b)
 #define find_in_my_stash(a,b)	S_find_in_my_stash(aTHX_ a,b)
 #define force_ident(a,b)	S_force_ident(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index 8599884..dfca40f 100644
--- a/proto.h
+++ b/proto.h
@@ -7213,6 +7213,8 @@ STATIC void	S_checkcomma(pTHX_ const char *s, const char *name, const char *what
 	assert(s); assert(name); assert(what)
 
 STATIC int	S_deprecate_commaless_var_list(pTHX);
+STATIC void	S_deprecate_empty_packages(pTHX_ char *s);
+STATIC void	S_deprecate_trailing_colons(pTHX_ char *s, STRLEN len);
 STATIC char *	S_filter_gets(pTHX_ SV *sv, STRLEN append)
 			__attribute__warn_unused_result__
 			__attribute__nonnull__(pTHX_1);
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index a7ee8de..645de80 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1420,3 +1420,42 @@ q
 1
 1
 q
+########
+# toke.c
+package ::;
+package foo::::bar;
+sub ::;
+sub foo::::bar;
+
+EXPECT
+Use of empty package names is deprecated at - line 2.
+Use of empty package names is deprecated at - line 3.
+Use of empty package names is deprecated at - line 4.
+Use of empty package names is deprecated at - line 5.
+########
+# toke.c
+no warnings 'deprecated' ;
+package ::;
+package foo::::bar;
+
+sub ::;
+sub foo::::bar;
+
+EXPECT
+########
+# toke.c
+package foo::;
+sub foo::;
+
+IO::Handle::->can("can");
+$::{foo::};
+
+EXPECT
+Use of trailing double colons in sub or package declaration is deprecated at - line 2.
+Use of trailing double colons in sub or package declaration is deprecated at - line 3.
+########
+# toke.c
+no warnings 'deprecated';
+package foo::;
+sub foo::;
+EXPECT
diff --git a/t/op/method.t b/t/op/method.t
index d206fc7..d05b88f 100644
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -479,7 +479,10 @@ sub SUPPER::foo { "supper" }
 is "SUPER"->foo, 'supper', 'SUPER->method';
 
 sub flomp { "flimp" }
+{
+no warnings 'deprecated';
 sub main::::flomp { "flump" }
+}
 is "::"->flomp, 'flump', 'method call on ::';
 is "::main"->flomp, 'flimp', 'method call on ::main';
 eval { ""->flomp };
diff --git a/t/op/stash.t b/t/op/stash.t
index 2681d47..5310265 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -319,6 +319,7 @@ fresh_perl_is(
 
 # [perl #88134] incorrect package structure
 {
+    no warnings 'deprecated';
     package Bear::;
     sub baz{1}
     package main;
diff --git a/t/run/switchd.t b/t/run/switchd.t
index f160fd5..8d323d8 100644
--- a/t/run/switchd.t
+++ b/t/run/switchd.t
@@ -109,7 +109,7 @@ like(
     'sub DB::sub { goto &$DB::sub }',
     'sub foo { goto &bar::baz; }',
     'sub bar::baz { print qq _ok\n_ }',
-    'delete $::{bar::::};',
+    'delete $::{bar::};',
     'foo();',
    ],
   ),
diff --git a/t/uni/stash.t b/t/uni/stash.t
index 7d24e51..67247da 100644
--- a/t/uni/stash.t
+++ b/t/uni/stash.t
@@ -297,6 +297,7 @@ plan( tests => 58 );
     
     # [perl #88134] incorrect package structure
     {
+        no warnings 'deprecated';
         package Bèàr::;
         sub bàz{1}
         package main;
diff --git a/toke.c b/toke.c
index 13265e1..7b181c9 100644
--- a/toke.c
+++ b/toke.c
@@ -491,6 +491,32 @@ S_deprecate_commaless_var_list(pTHX) {
     return REPORT(','); /* grandfather non-comma-format format */
 }
 
+PERL_STATIC_INLINE void
+S_deprecate_empty_packages(pTHX_ char *s) {
+    if ( s && *s && instr(s, "::::") ) {
+        deprecate("empty package names");
+    }
+    return;
+}
+
+PERL_STATIC_INLINE void
+S_deprecate_trailing_colons(pTHX_ char *s, STRLEN len) {
+    if ( s && *s && len ) {
+        if ( len == 2 && strEQ(s, "::") ) {
+              /* 'sub ::;' or 'package ::;' */
+            deprecate("empty package names");
+        }
+        /* foo:: */
+        if ( len >= 3 && *(s+len-3) != ':'
+           && strnEQ(s + len - 2, "::", 2) )
+        {
+            deprecate("trailing double colons in sub or package declaration");
+        }
+
+    }
+    return;
+}
+
 /*
  * S_ao
  *
@@ -7538,6 +7564,7 @@ Perl_yylex(pTHX)
 		    pl_yylval.opval->op_private |= OPpCONST_STRICT;
 		else {
 		bareword:
+		    deprecate_trailing_colons(PL_tokenbuf, strlen(PL_tokenbuf));
 		    /* after "print" and similar functions (corresponding to
 		     * "F? L" in opcode.pl), whatever wasn't already parsed as
 		     * a filehandle should be subject to "strict subs".
@@ -8333,12 +8360,20 @@ Perl_yylex(pTHX)
 	    LOP(OP_PACK,XTERM);
 
 	case KEY_package:
+   {
+       STRLEN len;
 	    s = force_word(s,WORD,FALSE,TRUE);
+       /* This is wrong on so many levels, but it works.
+        * force_word() calls scan_word() using PL_tokenbuf, and
+        * that's still holding the package name for us.
+        */
+       len = strlen(PL_tokenbuf);
+       deprecate_trailing_colons(PL_tokenbuf, len);
 	    s = SKIPSPACE1(s);
 	    s = force_strict_version(s);
 	    PL_lex_expect = XBLOCK;
 	    OPERATOR(PACKAGE);
-
+   }
 	case KEY_pipe:
 	    LOP(OP_PIPE_OP,XTERM);
 
@@ -8668,6 +8703,8 @@ Perl_yylex(pTHX)
 		    attrful = XATTRBLOCK;
 		    d = scan_word(s, tmpbuf, sizeof PL_tokenbuf - 1, TRUE,
 				  &len);
+
+                    deprecate_trailing_colons(tmpbuf, len);
 #ifdef PERL_MAD
 		    if (PL_madskills)
 			nametoke = newSVpvn_flags(s, d - s, SvUTF8(PL_linestr));
@@ -8690,7 +8727,6 @@ Perl_yylex(pTHX)
                         SvUTF8_on(PL_subname);
 		    have_name = TRUE;
 
-
 #ifdef PERL_MAD
 		    start_force(0);
 		    CURMAD('X', nametoke);
@@ -9360,6 +9396,8 @@ S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN
     parse_ident(&s, &d, e, allow_package, is_utf8);
     *d = '\0';
     *slp = d - dest;
+    if ( allow_package && *slp && *slp >= 4 )
+        deprecate_empty_packages(dest);
     return s;
 }
 
@@ -9394,6 +9432,7 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck
            (anything valid as a bareword), so job done and return.  */
 	if (PL_lex_state != LEX_NORMAL)
 	    PL_lex_state = LEX_INTERPENDMAYBE;
+	deprecate_empty_packages(d);
 	return s;
     }
     if (*s == '$' && s[1] &&
@@ -9470,6 +9509,7 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck
 		bracket++;
 		PL_lex_brackstack[PL_lex_brackets++] = (char)(XOPERATOR | XFAKEBRACK);
 		PL_lex_allbrackets++;
+                deprecate_empty_packages(dest);
 		return s;
 	    }
 	}
@@ -9522,6 +9562,7 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck
     }
     else if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets && !intuit_more(s))
 	PL_lex_state = LEX_INTERPEND;
+
     return s;
 }
 
-- 
1.7.10.4

@p5pRT
Copy link
Author

p5pRT commented Aug 1, 2013

From @tonycoz

0004-WIP.patch 
From 23bc479b341dd2ae83c2b292239f060dfc969d2a Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 16 Jul 2013 10:42:23 +1000
Subject: [PATCH 4/4] WIP

---
 t/base/lex.t |   12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/t/base/lex.t b/t/base/lex.t
index f023e57..7f44537 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..96\n";
+print "1..95\n";
 
 $x = 'x';
 
@@ -281,7 +281,7 @@ print $_ || "not ok $test\n";
 $test++;
 
 $_ = "";
-eval 's|(?:)|"${\<<END}"
+eval 's|(?:)|"${\<<\END}"
 ok $test - heredoc in "" in multiline s///e in eval
 END
 |e
@@ -426,22 +426,22 @@ q # comment
  "b"#
   eq 'b' or print "not ";
 print "ok $test - q <comment> <newline> ...\n";
-$text++
+$test++;
 qq # comment
  "b"#
   eq 'b' or print "not ";
 print "ok $test - qq <comment> <newline> ...\n";
-$test++
+$test++;
 qw # comment
  "b"#
   [0] eq 'b' or print "not ";
 print "ok $test - qw <comment> <newline> ...\n";
-$test++
+$test++;
 "b" =~ m # comment
  "b"#
    or print "not ";
 print "ok $test - m <comment> <newline> ...\n";
-$test++
+$test++;
 qr # comment
  "b"#
    eq qr/b/ or print "not ";
-- 
1.7.10.4

@p5pRT
Copy link
Author

p5pRT commented Aug 5, 2013

From @tonycoz

On Wed Jul 31 22​:29​:40 2013, tonyc wrote​:

I've attached the rebased patches, but the final patch is obviously
incomplete.

Brian updated his branch on github, I've attached the new patch series.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 5, 2013

From @tonycoz

0003-Deprecate-leading-double-colons-in-package-declarati.patch 
From 4252efbf7b2dcdd8908171e9a779fe3e5625dd56 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Fri, 15 Mar 2013 15:33:17 -0300
Subject: [PATCH 3/3] Deprecate leading double colons in package declarations
 and barewords

---
 t/lib/warnings/toke |   24 ++++++++++++++++++++++++
 toke.c              |   11 ++++++++++-
 2 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 645de80..4aa391a 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1459,3 +1459,27 @@ no warnings 'deprecated';
 package foo::;
 sub foo::;
 EXPECT
+########
+# toke.c
+package ::foo;
+sub ::foo;
+
+::IO::Handle->can("can");
+$::foo{foo};
+print STDOUT ::doof;
+
+EXPECT
+Use of leading double colons in package declarations is deprecated at - line 2.
+Use of leading double colons in barewords is deprecated at - line 7.
+::doof
+########
+# toke.c
+no warnings 'deprecated';
+package ::foo;
+sub ::foo;
+
+::IO::Handle->can("can");
+$::foo{foo};
+print STDOUT ::doof;
+EXPECT
+::doof
diff --git a/toke.c b/toke.c
index 10ae3bc..f98b28c 100644
--- a/toke.c
+++ b/toke.c
@@ -7564,7 +7564,13 @@ Perl_yylex(pTHX)
 		    pl_yylval.opval->op_private |= OPpCONST_STRICT;
 		else {
 		bareword:
-		    deprecate_trailing_colons(PL_tokenbuf, strlen(PL_tokenbuf));
+                {
+                    STRLEN tmplen = strlen(PL_tokenbuf);
+                    deprecate_trailing_colons(PL_tokenbuf, tmplen);
+                    if ( tmplen >= 3 && s[0] == ':' && s[1] == ':' && s[2] != ':' ) {
+                        deprecate("leading double colons in barewords");
+                    }
+                }
 		    /* after "print" and similar functions (corresponding to
 		     * "F? L" in opcode.pl), whatever wasn't already parsed as
 		     * a filehandle should be subject to "strict subs".
@@ -8369,6 +8375,9 @@ Perl_yylex(pTHX)
              */
             len = strlen(PL_tokenbuf);
             deprecate_trailing_colons(PL_tokenbuf, len);
+            if ( len >= 3 && PL_tokenbuf[0] == ':' && PL_tokenbuf[1] == ':' && PL_tokenbuf[2] != ':' ) {
+                deprecate("leading double colons in package declarations");
+            }
 	    s = SKIPSPACE1(s);
 	    s = force_strict_version(s);
 	    PL_lex_expect = XBLOCK;
-- 
1.7.10.4

@p5pRT
Copy link
Author

p5pRT commented Aug 5, 2013

From @tonycoz

0002-Stop-t-base-lex.t-from-warning.patch 
From 455ed960f9389f68e12338a1a618627cdb658fed Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Fri, 15 Mar 2013 14:43:39 -0300
Subject: [PATCH 2/3] Stop t/base/lex.t from warning

---
 t/base/lex.t |  110 +++++++++++++++++++++++++++++++++++-----------------------
 t/op/sub.t   |    7 +++-
 2 files changed, 72 insertions(+), 45 deletions(-)

diff --git a/t/base/lex.t b/t/base/lex.t
index 7821e76..d963ea4 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -262,9 +262,6 @@ print ((exists $str{foo}      ? "" : "not ")."ok $test\n"); ++$test;
 print ((exists $str{bar}      ? "" : "not ")."ok $test\n"); ++$test;
 print ((exists $str{xyz::bar} ? "" : "not ")."ok $test\n"); ++$test;
 
-sub foo::::::bar { print "ok $test\n"; $test++ }
-foo::::::bar;
-
 eval "\$x =\xE2foo";
 if ($@ =~ /Unrecognized character \\xE2; marked by <-- HERE after \$x =<-- HERE near column 5/) { print "ok $test\n"; } else { print "not ok $test\n"; }
 $test++;
@@ -272,108 +269,126 @@ $test++;
 # Is "[~" scanned correctly?
 @a = (1,2,3);
 print "not " unless($a[~~2] == 3);
-print "ok 57\n";
+print "ok $test\n";
+$test++;
 
 $_ = "";
-eval 's/(?:)/"${\q||}".<<\END/e;
-ok 58 - heredoc after "" in s/// in eval
+eval 's/(?:)/"${\q||}ok $test".<<\END/e;
+ - heredoc after "" in s/// in eval
 END
 ';
-print $_ || "not ok 58\n";
+print $_ || "not ok $test\n";
+$test++;
 
 $_ = "";
-eval 's|(?:)|"${\<<\END}"
-ok 59 - heredoc in "" in multiline s///e in eval
+eval 's|(?:)|"ok $test ${\<<\END}"
+- heredoc in "" in multiline s///e in eval
 END
 |e
 ';
-print $_ || "not ok 59\n";
+print $_ || "not ok $test\n";
+$test++;
 
 $_ = "";
 eval "s/(?:)/<<foo/e #\0
-ok 60 - null on same line as heredoc in s/// in eval
+ok $test - null on same line as heredoc in s/// in eval
 foo
 ";
-print $_ || "not ok 60\n";
+print $_ || "not ok $test\n";
+$test++;
 
 $_ = "";
 eval ' s/(?:)/"${\<<END}"/e;
-ok 61 - heredoc in "" in single-line s///e in eval
+ok $test - heredoc in "" in single-line s///e in eval
 END
 ';
-print $_ || "not ok 61\n";
+print $_ || "not ok $test\n";
+$test++;
 
 $_ = "";
 s|(?:)|"${\<<END}"
-ok 62 - heredoc in "" in multiline s///e outside eval
+ok $test - heredoc in "" in multiline s///e outside eval
 END
 |e;
-print $_ || "not ok 62\n";
+print $_ || "not ok $test\n";
+$test++;
 
-$_ = "not ok 63 - s/// in s/// pattern\n";
+$_ = "not ok $test - s/// in s/// pattern\n";
 s/${s|||;\""}not //;
 print;
+$test++;
 
 /(?{print <<END
-ok 64 - here-doc in re-eval
+ok $test - here-doc in re-eval
 END
 })/;
+$test++;
 
 eval '/(?{print <<END
-ok 65 - here-doc in re-eval in string eval
+ok $test - here-doc in re-eval in string eval
 END
 })/';
+$test++;
 
-eval 'print qq ;ok 66 - eval ending with semicolon\n;'
-  or print "not ok 66 - eval ending with semicolon\n";
+eval 'print qq ;ok $test - eval ending with semicolon\n;'
+  or print "not ok $test - eval ending with semicolon\n";
+$test++;
 
 print "not " unless qr/(?{<<END})/ eq '(?^:(?{<<END}))';
 foo
 END
-print "ok 67 - here-doc in single-line re-eval\n";
+print "ok $test - here-doc in single-line re-eval\n";
+$test++;
 
 $_ = qr/(?{"${<<END}"
 foo
 END
 })/;
 print "not " unless /foo/;
-print "ok 68 - here-doc in quotes in multiline re-eval\n";
+print "ok $test - here-doc in quotes in multiline re-eval\n";
+$test++;
 
 eval 's//<<END/e if 0; $_ = "a
 END
 b"';
 print "not " if $_ =~ /\n\n/;
-print "ok 69 - eval 's//<<END/' does not leave extra newlines\n";
+print "ok $test - eval 's//<<END/' does not leave extra newlines\n";
+$test++;
 
 $_ = a;
 eval "s/a/'b\0'#/e";
 print 'not ' unless $_ eq "b\0";
-print "ok 70 - # after null in s/// repl\n";
+print "ok $test - # after null in s/// repl\n";
+$test++;
 
 s//"#" . <<END/e;
 foo
 END
-print "ok 71 - s//'#' . <<END/e\n";
+print "ok $test - s//'#' . <<END/e\n";
+$test++;
 
 eval "s//3}->{3/e";
 print "not " unless $@;
-print "ok 72 - s//3}->{3/e\n";
+print "ok $test - s//3}->{3/e\n";
+$test++;
 
-$_ = "not ok 73";
+$_ = "not ok $test";
 $x{3} = "not ";
 eval 's/${\%x}{3}//e';
 print "$_ - s//\${\\%x}{3}/e\n";
+$test++;
 
 eval 's/${foo#}//e';
 print "not " unless $@;
-print "ok 74 - s/\${foo#}//e\n";
+print "ok $test - s/\${foo#}//e\n";
+$test++;
 
 eval 'warn ({$_ => 1} + 1) if 0';
 print "not " if $@;
-print "ok 75 - listop({$_ => 1} + 1)\n";
+print "ok $test - listop({$_ => 1} + 1)\n";
 print "# $@" if $@;
+$test++;
 
-$test = 76;
 for(qw< require goto last next redo dump >) {
     eval "sub { $_ foo << 2 }";
     print "not " if $@;
@@ -385,65 +400,72 @@ for(qw< require goto last next redo dump >) {
 my $counter = 0;
 eval 'v23: $counter++; goto v23 unless $counter == 2';
 print "not " unless $counter == 2;
-print "ok 82 - Use v[0-9]+ as a label\n";
+print "ok $test - Use v[0-9]+ as a label\n";
+$test++;
 $counter = 0;
 eval 'v23 : $counter++; goto v23 unless $counter == 2';
 print "not " unless $counter == 2;
-print "ok 83 - Use v[0-9]+ as a label with space before colon\n";
+print "ok $test - Use v[0-9]+ as a label with space before colon\n";
+$test++;
  
 my $output = "";
 eval "package v10::foo; sub test2 { return 'v10::foo' }
       package v10; sub test { return v10::foo::test2(); }
       package main; \$output = v10::test(); "; 
 print "not " unless $output eq 'v10::foo';
-print "ok 84 - call a function in package v10::foo\n";
+print "ok $test - call a function in package v10::foo\n";
+$test++;
 
 print "not " unless (1?v65:"bar") eq 'A';
-print "ok 85 - colon detection after vstring does not break ? vstring :\n";
+print "ok $test - colon detection after vstring does not break ? vstring :\n";
+$test++;
 
 # Test pyoq ops with comments before the first delim
 q # comment
  "b"#
   eq 'b' or print "not ";
-print "ok 86 - q <comment> <newline> ...\n";
+print "ok $test - q <comment> <newline> ...\n"; $test++;
 qq # comment
  "b"#
   eq 'b' or print "not ";
-print "ok 87 - qq <comment> <newline> ...\n";
+print "ok $test - qq <comment> <newline> ...\n"; $test++;
 qw # comment
  "b"#
   [0] eq 'b' or print "not ";
-print "ok 88 - qw <comment> <newline> ...\n";
+print "ok $test - qw <comment> <newline> ...\n"; $test++;
 "b" =~ m # comment
  "b"#
    or print "not ";
-print "ok 89 - m <comment> <newline> ...\n";
+print "ok $test - m <comment> <newline> ...\n"; $test++;
 qr # comment
  "b"#
    eq qr/b/ or print "not ";
-print "ok 90 - qr <comment> <newline> ...\n";
+print "ok $test - qr <comment> <newline> ...\n"; $test++;
 $_ = "a";
 s # comment
  [a] #
  [b] #
  ;
 print "not " unless $_ eq 'b';
-print "ok 91 - s <comment> <newline> ...\n";
+print "ok $test - s <comment> <newline> ...\n"; $test++;
 $_ = "a";
 tr # comment
  [a] #
  [b] #
  ;
 print "not " unless $_ eq 'b';
-print "ok 92 - tr <comment> <newline> ...\n";
+print "ok $test - tr <comment> <newline> ...\n"; $test++;
 $_ = "a";
 y # comment
  [a] #
  [b] #
  ;
 print "not " unless $_ eq 'b';
-print "ok 93 - y <comment> <newline> ...\n";
+print "ok $test - y <comment> <newline> ...\n"; $test++;
 
 print "not " unless (time
                      =>) eq time=>;
-print "ok 94 - => quotes keywords across lines\n";
+print "ok $test - => quotes keywords across lines\n"; $test++;
+print "ok $test - colon detection after vstring does not break ? vstring :\n";
+$test++;
+
diff --git a/t/op/sub.t b/t/op/sub.t
index fc04ac8..fcd6f97 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 27 );
+plan( tests => 28 );
 
 sub empty_sub {}
 
@@ -165,3 +165,8 @@ is eval {
     is $w, undef,
       '*keyword = sub():method{$y} does not cause ambiguity warnings';
 }
+{
+    no warnings 'deprecated';
+    sub foo::::::bar { ok(1, "sub foo::::bar {} foo::::bar() works") }
+    foo::::::bar;
+}
-- 
1.7.10.4

@p5pRT
Copy link
Author

p5pRT commented Aug 5, 2013

From @tonycoz

0001-Deprecate-empty-package-names-and-trailing-double-co.patch 
From 016d2ac8c7dd11f9c83f1df6ed10266027b29c37 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sun, 4 Aug 2013 17:20:31 -0300
Subject: [PATCH 1/3] Deprecate empty package names and trailing double
 colons.

This commit adds two new deprecations:
* Use of empty package names is deprecated
Triggered by things like sub foo::::bar, $foo::::::bar,
or package foo::'bar, or sub ::;

* Use of trailing double colons in sub or package declaration is deprecated
Triggered by package foo::; and sub foo::;
---
 dist/B-Deparse/t/deparse.t |    2 ++
 embed.fnc                  |    2 ++
 embed.h                    |    2 ++
 proto.h                    |    2 ++
 t/lib/warnings/toke        |   39 +++++++++++++++++++++++++++++++++++
 t/op/method.t              |    3 +++
 t/op/stash.t               |    1 +
 t/run/switchd.t            |    2 +-
 t/uni/stash.t              |    1 +
 toke.c                     |   49 ++++++++++++++++++++++++++++++++++++++++----
 10 files changed, 98 insertions(+), 5 deletions(-)

diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 5087485..8bb6891 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -176,6 +176,7 @@ EOFCODE
 # Exotic sub declarations
 $a = `$^X $path "-MO=Deparse" -e "sub ::::{}sub ::::::{}" 2>&1`;
 $a =~ s/-e syntax OK\n//g;
+$a =~ s/Use of empty package.+\n//g;
 is($a, <<'EOCODG', "sub :::: and sub ::::::");
 sub :::: {
     
@@ -458,6 +459,7 @@ my $f = sub {
 '::::'->();
 ####
 # bug #43010
+no warnings;
 &::::;
 ####
 # [perl #77172]
diff --git a/embed.fnc b/embed.fnc
index f3e351e..d268065 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2255,6 +2255,8 @@ so	|SV*	|new_constant	|NULLOK const char *s|STRLEN len \
 				|NULLOK SV *pv|NULLOK const char *type \
 				|STRLEN typelen
 s	|int	|deprecate_commaless_var_list
+s  |void  |deprecate_empty_packages|NULLOK char *s
+s  |void  |deprecate_trailing_colons|NULLOK char *s|STRLEN len
 s	|int	|ao		|int toketype
 s  |void|parse_ident|NN char **s|NN char **d \
                      |NN char * const e|int allow_package \
diff --git a/embed.h b/embed.h
index 9b5125a..0a40703 100644
--- a/embed.h
+++ b/embed.h
@@ -1601,6 +1601,8 @@
 #define check_uni()		S_check_uni(aTHX)
 #define checkcomma(a,b,c)	S_checkcomma(aTHX_ a,b,c)
 #define deprecate_commaless_var_list()	S_deprecate_commaless_var_list(aTHX)
+#define deprecate_empty_packages(a)	S_deprecate_empty_packages(aTHX_ a)
+#define deprecate_trailing_colons(a,b)	S_deprecate_trailing_colons(aTHX_ a,b)
 #define filter_gets(a,b)	S_filter_gets(aTHX_ a,b)
 #define find_in_my_stash(a,b)	S_find_in_my_stash(aTHX_ a,b)
 #define force_ident(a,b)	S_force_ident(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index e57f3ea..ad87532 100644
--- a/proto.h
+++ b/proto.h
@@ -7222,6 +7222,8 @@ STATIC void	S_checkcomma(pTHX_ const char *s, const char *name, const char *what
 	assert(s); assert(name); assert(what)
 
 STATIC int	S_deprecate_commaless_var_list(pTHX);
+STATIC void	S_deprecate_empty_packages(pTHX_ char *s);
+STATIC void	S_deprecate_trailing_colons(pTHX_ char *s, STRLEN len);
 STATIC char *	S_filter_gets(pTHX_ SV *sv, STRLEN append)
 			__attribute__warn_unused_result__
 			__attribute__nonnull__(pTHX_1);
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index a7ee8de..645de80 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1420,3 +1420,42 @@ q
 1
 1
 q
+########
+# toke.c
+package ::;
+package foo::::bar;
+sub ::;
+sub foo::::bar;
+
+EXPECT
+Use of empty package names is deprecated at - line 2.
+Use of empty package names is deprecated at - line 3.
+Use of empty package names is deprecated at - line 4.
+Use of empty package names is deprecated at - line 5.
+########
+# toke.c
+no warnings 'deprecated' ;
+package ::;
+package foo::::bar;
+
+sub ::;
+sub foo::::bar;
+
+EXPECT
+########
+# toke.c
+package foo::;
+sub foo::;
+
+IO::Handle::->can("can");
+$::{foo::};
+
+EXPECT
+Use of trailing double colons in sub or package declaration is deprecated at - line 2.
+Use of trailing double colons in sub or package declaration is deprecated at - line 3.
+########
+# toke.c
+no warnings 'deprecated';
+package foo::;
+sub foo::;
+EXPECT
diff --git a/t/op/method.t b/t/op/method.t
index d206fc7..d05b88f 100644
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -479,7 +479,10 @@ sub SUPPER::foo { "supper" }
 is "SUPER"->foo, 'supper', 'SUPER->method';
 
 sub flomp { "flimp" }
+{
+no warnings 'deprecated';
 sub main::::flomp { "flump" }
+}
 is "::"->flomp, 'flump', 'method call on ::';
 is "::main"->flomp, 'flimp', 'method call on ::main';
 eval { ""->flomp };
diff --git a/t/op/stash.t b/t/op/stash.t
index 2681d47..5310265 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -319,6 +319,7 @@ fresh_perl_is(
 
 # [perl #88134] incorrect package structure
 {
+    no warnings 'deprecated';
     package Bear::;
     sub baz{1}
     package main;
diff --git a/t/run/switchd.t b/t/run/switchd.t
index f160fd5..8d323d8 100644
--- a/t/run/switchd.t
+++ b/t/run/switchd.t
@@ -109,7 +109,7 @@ like(
     'sub DB::sub { goto &$DB::sub }',
     'sub foo { goto &bar::baz; }',
     'sub bar::baz { print qq _ok\n_ }',
-    'delete $::{bar::::};',
+    'delete $::{bar::};',
     'foo();',
    ],
   ),
diff --git a/t/uni/stash.t b/t/uni/stash.t
index 7d24e51..67247da 100644
--- a/t/uni/stash.t
+++ b/t/uni/stash.t
@@ -297,6 +297,7 @@ plan( tests => 58 );
     
     # [perl #88134] incorrect package structure
     {
+        no warnings 'deprecated';
         package Bèàr::;
         sub bàz{1}
         package main;
diff --git a/toke.c b/toke.c
index 13265e1..10ae3bc 100644
--- a/toke.c
+++ b/toke.c
@@ -491,6 +491,32 @@ S_deprecate_commaless_var_list(pTHX) {
     return REPORT(','); /* grandfather non-comma-format format */
 }
 
+PERL_STATIC_INLINE void
+S_deprecate_empty_packages(pTHX_ char *s) {
+    if ( s && *s && instr(s, "::::") ) {
+        deprecate("empty package names");
+    }
+    return;
+}
+
+PERL_STATIC_INLINE void
+S_deprecate_trailing_colons(pTHX_ char *s, STRLEN len) {
+    if ( s && *s && len ) {
+        if ( len == 2 && strEQ(s, "::") ) {
+              /* 'sub ::;' or 'package ::;' */
+            deprecate("empty package names");
+        }
+        /* foo:: */
+        if ( len >= 3 && *(s+len-3) != ':'
+           && strnEQ(s + len - 2, "::", 2) )
+        {
+            deprecate("trailing double colons in sub or package declaration");
+        }
+
+    }
+    return;
+}
+
 /*
  * S_ao
  *
@@ -7167,7 +7193,7 @@ Perl_yylex(pTHX)
 		    len += morelen;
 		    pkgname = 1;
 		}
-
+		
 		if (PL_expect == XOPERATOR) {
 		    if (PL_bufptr == PL_linestart) {
 			CopLINE_dec(PL_curcop);
@@ -7538,6 +7564,7 @@ Perl_yylex(pTHX)
 		    pl_yylval.opval->op_private |= OPpCONST_STRICT;
 		else {
 		bareword:
+		    deprecate_trailing_colons(PL_tokenbuf, strlen(PL_tokenbuf));
 		    /* after "print" and similar functions (corresponding to
 		     * "F? L" in opcode.pl), whatever wasn't already parsed as
 		     * a filehandle should be subject to "strict subs".
@@ -8333,12 +8360,20 @@ Perl_yylex(pTHX)
 	    LOP(OP_PACK,XTERM);
 
 	case KEY_package:
+        {
+            STRLEN len;
 	    s = force_word(s,WORD,FALSE,TRUE);
+            /* This is wrong on so many levels, but it works.
+             * force_word() calls scan_word() using PL_tokenbuf, and
+             * that's still holding the package name for us.
+             */
+            len = strlen(PL_tokenbuf);
+            deprecate_trailing_colons(PL_tokenbuf, len);
 	    s = SKIPSPACE1(s);
 	    s = force_strict_version(s);
 	    PL_lex_expect = XBLOCK;
 	    OPERATOR(PACKAGE);
-
+        }
 	case KEY_pipe:
 	    LOP(OP_PIPE_OP,XTERM);
 
@@ -8668,6 +8703,8 @@ Perl_yylex(pTHX)
 		    attrful = XATTRBLOCK;
 		    d = scan_word(s, tmpbuf, sizeof PL_tokenbuf - 1, TRUE,
 				  &len);
+
+          deprecate_trailing_colons(tmpbuf, len);
 #ifdef PERL_MAD
 		    if (PL_madskills)
 			nametoke = newSVpvn_flags(s, d - s, SvUTF8(PL_linestr));
@@ -8690,7 +8727,6 @@ Perl_yylex(pTHX)
                         SvUTF8_on(PL_subname);
 		    have_name = TRUE;
 
-
 #ifdef PERL_MAD
 		    start_force(0);
 		    CURMAD('X', nametoke);
@@ -9360,6 +9396,8 @@ S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN
     parse_ident(&s, &d, e, allow_package, is_utf8);
     *d = '\0';
     *slp = d - dest;
+    if ( allow_package && *slp && *slp >= 4 )
+            deprecate_empty_packages(dest);
     return s;
 }
 
@@ -9394,7 +9432,8 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck
            (anything valid as a bareword), so job done and return.  */
 	if (PL_lex_state != LEX_NORMAL)
 	    PL_lex_state = LEX_INTERPENDMAYBE;
-	return s;
+        deprecate_empty_packages(d);
+        return s;
     }
     if (*s == '$' && s[1] &&
       (isIDFIRST_lazy_if(s+1,is_utf8)
@@ -9470,6 +9509,7 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck
 		bracket++;
 		PL_lex_brackstack[PL_lex_brackets++] = (char)(XOPERATOR | XFAKEBRACK);
 		PL_lex_allbrackets++;
+      deprecate_empty_packages(dest);
 		return s;
 	    }
 	}
@@ -9522,6 +9562,7 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck
     }
     else if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets && !intuit_more(s))
 	PL_lex_state = LEX_INTERPEND;
+
     return s;
 }
 
-- 
1.7.10.4

@p5pRT
Copy link
Author

p5pRT commented Aug 5, 2013

From @tonycoz

On Sun Aug 04 18​:59​:28 2013, tonyc wrote​:

On Wed Jul 31 22​:29​:40 2013, tonyc wrote​:

I've attached the rebased patches, but the final patch is obviously
incomplete.

Brian updated his branch on github, I've attached the new patch series.

Tony

The only questionable part to me (besides some whitespace issues), is
this modification to S_scan_word()​:

@​@​ -9360,6 +9396,8 @​@​ S_scan_word(pTHX_ char *s, char *dest, STRLEN
destlen, int allow_package, STRLEN
  parse_ident(&s, &d, e, allow_package, is_utf8);
  *d = '\0';
  *slp = d - dest;
+ if ( allow_package && *slp && *slp >= 4 )
+ deprecate_empty_packages(dest);
  return s;
}

I know parsers (and especially perl's parser) tend to be messy, but I'm
not sure that check belongs in scan_word - changing it from "scan a
word" to "scan a word and optionally warn".

Unless someone else speaks up I plan to apply it as is (with whitespace
fixes.)

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 5, 2013

From @cpansprout

On Sun Aug 04 19​:02​:50 2013, tonyc wrote​:

On Sun Aug 04 18​:59​:28 2013, tonyc wrote​:

On Wed Jul 31 22​:29​:40 2013, tonyc wrote​:

I've attached the rebased patches, but the final patch is obviously
incomplete.

Brian updated his branch on github, I've attached the new patch series.

Tony

The only questionable part to me (besides some whitespace issues), is
this modification to S_scan_word()​:

@​@​ -9360,6 +9396,8 @​@​ S_scan_word(pTHX_ char *s, char *dest, STRLEN
destlen, int allow_package, STRLEN
parse_ident(&s, &d, e, allow_package, is_utf8);
*d = '\0';
*slp = d - dest;
+ if ( allow_package && *slp && *slp >= 4 )
+ deprecate_empty_packages(dest);
return s;
}

I know parsers (and especially perl's parser) tend to be messy, but I'm
not sure that check belongs in scan_word - changing it from "scan a
word" to "scan a word and optionally warn".

That could be problematic if scan_word is called multiple times for the
same word, which is not implausible. Finding out whether that can
happen will take some work.

Unless someone else speaks up I plan to apply it as is (with whitespace
fixes.)

Are we going to apply it before we have even discussed why we are
deprecating this, i.e., what problem we are trying to solve?

Also, deprecating leading :​: except when a sub with that name exists
doesn’t make sense to me. That’s deprecating something except when
people use it.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Aug 6, 2013

From @tonycoz

On Sun Aug 04 23​:37​:20 2013, sprout wrote​:

On Sun Aug 04 19​:02​:50 2013, tonyc wrote​:

Unless someone else speaks up I plan to apply it as is (with whitespace
fixes.)

Are we going to apply it before we have even discussed why we are
deprecating this, i.e., what problem we are trying to solve?

Also, deprecating leading :​: except when a sub with that name exists
doesn’t make sense to me. That’s deprecating something except when
people use it.

I'm not too worried either way about the deprecation, but I didn't find
your arguments all that convincing.

I don't have a problem with more discussion, though I feel a bit bad for
Brian over the work he's done on the patch if it doesn't go ahead.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 6, 2013

From @cpansprout

On Mon Aug 05 17​:15​:10 2013, tonyc wrote​:

On Sun Aug 04 23​:37​:20 2013, sprout wrote​:

On Sun Aug 04 19​:02​:50 2013, tonyc wrote​:

Unless someone else speaks up I plan to apply it as is (with
whitespace
fixes.)

Are we going to apply it before we have even discussed why we are
deprecating this, i.e., what problem we are trying to solve?

Also, deprecating leading :​: except when a sub with that name exists
doesn’t make sense to me. That’s deprecating something except when
people use it.

I'm not too worried either way about the deprecation, but I didn't find
your arguments all that convincing.

I don't have a problem with more discussion,

I have not yet heard any arguments in favour of the deprecation, other
than ‘we are going to do this’. I would like to know what problem is
being solved here.

though I feel a bit bad for
Brian over the work he's done on the patch if it doesn't go ahead.

Brian, I hope you don’t feel bad. After all, we’ve all written patches
that haven’t been applied. :-)

--

Father Chrysostomos

@epa
Copy link
Contributor

epa commented Mar 9, 2020

My two cents is that this deprecation will be particularly useful in clearing up some odd cases with the old ' package separator used in doublequoted strings. Those do cause bugs in practice (speaking from my experience). If deprecating the weird empty package names in general is the easiest way to do that, so be it.

There are also arguments from the correspondence between package names and .pm files in the filesystem.

@xenu xenu removed the Severity Low label Dec 29, 2021
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Assignees
No one assigned
Labels
distro-All hasPatch type-core
Projects
None yet
Milestone
No milestone
Development

No branches or pull requests
3 participants
@epa @xenu @p5pRT