diff options
| -rw-r--r-- | ext/threads/t/problems.t | 13 | ||||
| -rw-r--r-- | pod/perldiag.pod | 5 | ||||
| -rw-r--r-- | toke.c | 22 | ||||
| -rw-r--r-- | xsutils.c | 12 |
4 files changed, 32 insertions, 20 deletions
diff --git a/ext/threads/t/problems.t b/ext/threads/t/problems.t index d555dcdc24..f4688134e5 100644 --- a/ext/threads/t/problems.t +++ b/ext/threads/t/problems.t @@ -18,7 +18,7 @@ use threads::shared; # call is() from within the DESTROY() function at global destruction time, # and parts of Test::* may have already been freed by then -print "1..8\n"; +print "1..10\n"; my $test : shared = 1; @@ -93,6 +93,17 @@ threads->new( } )->join; +# bugid #24940 :unique should fail on my and sub declarations + +for my $decl ('my $x : unique', 'sub foo : unique') { + eval $decl; + print $@ =~ + /^The 'unique' attribute may only be applied to 'our' variables/ + ? '' : 'not ', "ok $test - $decl\n"; + $test++; +} + + # Returing a closure from a thread caused problems. If the last index in # the anon sub's pad wasn't for a lexical, then a core dump could occur. # Otherwise, there might be leaked scalars. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 69c22d60f5..38be87a625 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3668,6 +3668,11 @@ linkhood if the last stat that wrote to the stat buffer already went past the symlink to get to the real file. Use an actual filename instead. +=item The 'unique' attribute may only be applied to 'our' variables + +(F) Currently this attribute is not supported on C<my> or C<sub> +declarations. See L<perlfunc/our>. + =item This Perl can't reset CRTL environ elements (%s) =item This Perl can't set CRTL environ elements (%s=%s) @@ -1,7 +1,7 @@ /* toke.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -3035,9 +3035,20 @@ Perl_yylex(pTHX) PL_lex_stuff = Nullsv; } else { + if (len == 6 && strnEQ(s, "unique", len)) { + if (PL_in_my == KEY_our) +#ifdef USE_ITHREADS + GvUNIQUE_on(cGVOPx_gv(yylval.opval)); +#else + ; /* skip to avoid loading attributes.pm */ +#endif + else + Perl_croak(aTHX_ "The 'unique' attribute may only be applied to 'our' variables"); + } + /* NOTE: any CV attrs applied here need to be part of the CVf_BUILTIN_ATTRS define in cv.h! */ - if (!PL_in_my && len == 6 && strnEQ(s, "lvalue", len)) + else if (!PL_in_my && len == 6 && strnEQ(s, "lvalue", len)) CvLVALUE_on(PL_compcv); else if (!PL_in_my && len == 6 && strnEQ(s, "locked", len)) CvLOCKED_on(PL_compcv); @@ -3045,13 +3056,6 @@ Perl_yylex(pTHX) CvMETHOD_on(PL_compcv); else if (!PL_in_my && len == 9 && strnEQ(s, "assertion", len)) CvASSERTION_on(PL_compcv); - else if (PL_in_my == KEY_our && len == 6 && - strnEQ(s, "unique", len)) -#ifdef USE_ITHREADS - GvUNIQUE_on(cGVOPx_gv(yylval.opval)); -#else - ; /* skip that case to avoid loading attributes.pm */ -#endif /* After we've set the flags, it could be argued that we don't need to do the attributes.pm-based setting process, and shouldn't bother appending recognized @@ -1,6 +1,7 @@ /* xsutils.c * - * Copyright (C) 1999, 2000, 2001, 2002, 2003, by Larry Wall and others + * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, + * by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -108,15 +109,6 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) continue; } break; - case 'u': - if (strEQ(name, "unique")) { - if (negated) - GvUNIQUE_off(CvGV((CV*)sv)); - else - GvUNIQUE_on(CvGV((CV*)sv)); - continue; - } - break; } break; } |