From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 26 Nov 2007 12:32:00 +0000 (+0000)
Subject: Disallow attributes that are not valid perl
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fcbc2cdbfb87f2f022dd44fc82e01764faffaa19;p=p5sagit%2Fp5-mst-13.2.git

Disallow attributes that are not valid perl
(patch by Damian)

p4raw-id: //depot/perl@32496
---

diff --git a/lib/Attribute/Handlers.pm b/lib/Attribute/Handlers.pm
index aa4eada..27b60af 100644
--- a/lib/Attribute/Handlers.pm
+++ b/lib/Attribute/Handlers.pm
@@ -190,9 +190,14 @@ sub _apply_handler_AH_ {
 	my $sym = findsym($pkg, $ref);
 	$sym ||= $type eq 'CODE' ? 'ANON' : 'LEXICAL';
 	no warnings;
-	my $evaled = !$raw && eval("package $pkg; no warnings; no strict;
-				    local \$SIG{__WARN__}=sub{die}; [$data]");
-	$data = $evaled || [$data];
+	if (!$raw) {
+	    $data = !$raw && eval("package $pkg; no warnings; no strict;
+				   local \$SIG{__WARN__}=sub{die}; [$data]");
+	    if (my $error = $@) {
+		$error =~ s{\s+ at \s+ \(eval \s+ \S+\) \s+ line \s+ \S+}{}x;
+		die "Bad data for $attr attribute: $error\n";
+	    }
+	}
 	$pkg->$handler($sym,
 		       (ref $sym eq 'GLOB' ? *{$sym}{ref $ref}||$ref : $ref),
 		       $attr,
@@ -811,6 +816,11 @@ An attribute handler was specified with an C<:ATTR(I<ref_type>)>, but the
 type of referent it was defined to handle wasn't one of the five permitted:
 C<SCALAR>, C<ARRAY>, C<HASH>, C<CODE>, or C<ANY>.
 
+=item C<Bad data for %s attribute: %s>
+
+The data specified as part of the named attribute wasn't valid Perl.
+The error message indicates why it didn't compile.
+
 =item C<Attribute handler %s doesn't handle %s attributes>
 
 A handler for attributes of the specified name I<was> defined, but not
diff --git a/lib/Attribute/Handlers/t/data_convert.t b/lib/Attribute/Handlers/t/data_convert.t
index b0c37c3..14788c1 100644
--- a/lib/Attribute/Handlers/t/data_convert.t
+++ b/lib/Attribute/Handlers/t/data_convert.t
@@ -41,14 +41,14 @@ sub test5 :Loud(till,ears,are,bleeding) {
     [qw(till ears are bleeding)]
 }
 
-sub test6 :Loud(my,ears,are,bleeding) {
-    'my,ears,are,bleeding';
+sub test6 :Loud("turn it up to 11, man!") {
+    'turn it up to 11, man!';
 }
 
-sub test7 :Loud(qw/my ears are bleeding) {
-    'qw/my ears are bleeding'; #'
-}
+::ok !defined eval q{
+    sub test7 :Loud(my,ears,are,bleeding) {}
+}, 'test7';
 
-sub test8 :Loud("turn it up to 11, man!") {
-    'turn it up to 11, man!';
-}
+::ok !defined eval q{
+    sub test8 :Loud(qw/my ears are bleeding) {}
+}, 'test8';