diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2015-01-18 22:40:09 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2015-01-19 20:34:05 -0800 |
| commit | 3108f4dfc5963ac9d63390f67ac6697a36bf21b4 (patch) | |
| tree | 12ff945df8b2255e9cc9051829e0ab1061e8b55e /ext/attributes | |
| parent | 56c1c96f488940636d0ba81097097eeee1420ce4 (diff) | |
| download | perl-3108f4dfc5963ac9d63390f67ac6697a36bf21b4.tar.gz | |
Let attributes.pm know about the const attribute
Setting it has no affect except on closure prototypes, so warn if an
attempt is made to set it on any other sub.
Diffstat (limited to 'ext/attributes')
| -rw-r--r-- | ext/attributes/attributes.pm | 12 | ||||
| -rw-r--r-- | ext/attributes/attributes.xs | 14 |
2 files changed, 22 insertions, 4 deletions
diff --git a/ext/attributes/attributes.pm b/ext/attributes/attributes.pm index dfd3a2594c..bac3d7be99 100644 --- a/ext/attributes/attributes.pm +++ b/ext/attributes/attributes.pm @@ -23,6 +23,12 @@ $deprecated{CODE} = qr/\A-?(locked)\z/; $deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} = qr/\A-?(unique)\z/; +my %msg = ( + lvalue => 'lvalue attribute applied to already-defined subroutine', + -lvalue => 'lvalue attribute removed from already-defined subroutine', + const => 'Useless use of attribute "const"', +); + sub _modify_attrs_and_deprecate { my $svtype = shift; # Now that we've removed handling of locked from the XS code, we need to @@ -34,13 +40,11 @@ sub _modify_attrs_and_deprecate { require warnings; warnings::warnif('deprecated', "Attribute \"$1\" is deprecated"); 0; - } : $svtype eq 'CODE' && /^-?lvalue\z/ ? do { + } : $svtype eq 'CODE' && exists $msg{$_} ? do { require warnings; warnings::warnif( 'misc', - "lvalue attribute " - . (/^-/ ? "removed from" : "applied to") - . " already-defined subroutine" + $msg{$_} ); 0; } : 1 diff --git a/ext/attributes/attributes.xs b/ext/attributes/attributes.xs index 6b36812b13..7ba4f12613 100644 --- a/ext/attributes/attributes.xs +++ b/ext/attributes/attributes.xs @@ -44,6 +44,20 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) switch (SvTYPE(sv)) { case SVt_PVCV: switch ((int)len) { + case 5: + if (memEQ(name, "const", 5)) { + if (negated) + CvANONCONST_off(sv); + else { + const bool warn = (!CvCLONE(sv) || CvCLONED(sv)) + && !CvANONCONST(sv); + CvANONCONST_on(sv); + if (warn) + break; + } + continue; + } + break; case 6: switch (name[3]) { case 'l': |