From: Dave Mitchell Date: Tue, 20 Jan 2004 22:27:50 +0000 (+0000) Subject: [perl #24940] "sub foo :unique" segfaults X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=371fce9b46bb8a15ccc0f7dd533facec7830b379;p=p5sagit%2Fp5-mst-13.2.git [perl #24940] "sub foo :unique" segfaults Turn these two into compile-time errors until such time as someone thinks of a useful meaning for them: my $x : unique sub foo : unique p4raw-id: //depot/perl@22187 --- diff --git a/ext/threads/t/problems.t b/ext/threads/t/problems.t index d555dcd..f468813 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 69c22d6..38be87a 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 or C +declarations. See L. + =item This Perl can't reset CRTL environ elements (%s) =item This Perl can't set CRTL environ elements (%s=%s) diff --git a/toke.c b/toke.c index 5e4c7e7..bc4194b 100644 --- a/toke.c +++ b/toke.c @@ -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 diff --git a/xsutils.c b/xsutils.c index 622a49b..9844b0e 100644 --- a/xsutils.c +++ b/xsutils.c @@ -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; }