[libmoo-perl] 06/43: throw more reasonable errors for invalid sub names
gregor herrmann
gregoa at debian.org
Mon Dec 26 17:56:13 UTC 2016
This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to branch master
in repository libmoo-perl.
commit 5152d8cf9d8aefdfd510360bb4a0833cc2e5ff4c
Author: Graham Knop <haarg at haarg.org>
Date: Fri Sep 9 16:47:15 2016 -0400
throw more reasonable errors for invalid sub names
---
lib/Sub/Quote.pm | 4 ++++
t/sub-quote.t | 20 ++++++++++++++++++++
2 files changed, 24 insertions(+)
diff --git a/lib/Sub/Quote.pm b/lib/Sub/Quote.pm
index 4a293fe..8ba8b06 100644
--- a/lib/Sub/Quote.pm
+++ b/lib/Sub/Quote.pm
@@ -96,8 +96,12 @@ sub quote_sub {
$name = join '::', $package, $subname;
croak qq{package name "$package" too long!}
if length $package > 252;
+ croak qq{package name "$package" is not valid!}
+ unless $package =~ /^[^\d\W]\w*(?:::\w+)*$/;
croak qq{sub name "$subname" too long!}
if length $subname > 252;
+ croak qq{sub name "$subname" is not valid!}
+ unless $subname =~ /^[^\d\W]\w*$/;
}
my @caller = caller(0);
my $attributes = $options->{attributes};
diff --git a/t/sub-quote.t b/t/sub-quote.t
index 9a07fc6..da526d5 100644
--- a/t/sub-quote.t
+++ b/t/sub-quote.t
@@ -94,6 +94,26 @@ like exception {
}, qr/^sub name "$long$long" too long/,
'over long sub names error';
+like exception {
+ quote_sub "got a space::gorp", q{ return 1; };
+}, qr/^package name "got a space" is not valid!/,
+ 'packages with spaces are invalid';
+
+like exception {
+ quote_sub "Gorp::got a space", q{ return 1; };
+}, qr/^sub name "got a space" is not valid!/,
+ 'sub names with spaces are invalid';
+
+like exception {
+ quote_sub "0welp::gorp", q{ return 1; };
+}, qr/^package name "0welp" is not valid!/,
+ 'package names starting with numbers are not valid';
+
+like exception {
+ quote_sub "Gorp::0welp", q{ return 1; };
+}, qr/^sub name "0welp" is not valid!/,
+ 'sub names starting with numbers are not valid';
+
my $broken_quoted = quote_sub q{
return 5<;
};
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmoo-perl.git
More information about the Pkg-perl-cvs-commits
mailing list