From: Nicholas Clark Date: Mon, 12 Feb 2001 16:43:51 +0000 (+0000) Subject: Apply the spirit of patch from Nicholas Clark: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=64977eb6138422a1560c20575c46ef223d980150;p=p5sagit%2Fp5-mst-13.2.git Apply the spirit of patch from Nicholas Clark: Subject: [PATCH] Re: extensions that provide layers Message-Id: <20010212164350.Q3652@plum.flirble.org> p4raw-id: //depot/perlio@8830 --- diff --git a/perlio.c b/perlio.c index 7d95735..dd1c9ce 100644 --- a/perlio.c +++ b/perlio.c @@ -553,7 +553,8 @@ PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,STRLEN l->next = *f; l->tab = tab; *f = l; - PerlIO_debug("PerlIO_push f=%p %s %s\n",f,tab->name,(mode) ? mode : "(Null)"); + PerlIO_debug("PerlIO_push f=%p %s %s '%.*s'\n", + f,tab->name,(mode) ? mode : "(Null)",(int) len,arg); if ((*l->tab->Pushed)(f,mode,arg,len) != 0) { PerlIO_pop(f); @@ -620,56 +621,71 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) s++; if (*s) { + STRLEN llen = 0; const char *e = s; const char *as = Nullch; - const char *ae = Nullch; - int count = 0; - while (*e && *e != ':' && !isSPACE(*e)) + STRLEN alen = 0; + if (!isIDFIRST(*s)) { - if (*e == '(') - { - if (!as) - as = e; - count++; - } - else if (*e == ')') + /* Message is consistent with how attribute lists are passed. + Even though this means "foo : : bar" is seen as an invalid separator + character. */ + char q = ((*s == '\'') ? '"' : '\''); + Perl_warn(aTHX_ "perlio: invalid separator character %c%c%c in layer specification list", q, *s, q); + return -1; + } + do + { + e++; + } while (isALNUM(*e)); + llen = e-s; + if (*e == '(') + { + int nesting = 1; + as = ++e; + while (nesting) { - if (as && --count == 0) - ae = e; + switch (*e++) + { + case ')': + if (--nesting == 0) + alen = (e-1)-as; + break; + case '(': + ++nesting; + break; + case '\\': + /* It's a nul terminated string, not allowed to \ the terminating null. + Anything other character is passed over. */ + if (*e++) + { + break; + } + /* Drop through */ + case '\0': + e--; + Perl_warn(aTHX_ "perlio: argument list not closed for layer \"%.*s\"",(int)(e - s),s); + return -1; + default: + /* boring. */ + break; + } } - e++; } if (e > s) { - if ((e - s) == 4 && strncmp(s,"utf8",4) == 0) - { - PerlIOBase(f)->flags |= PERLIO_F_UTF8; - } - else if ((e - s) == 5 && strncmp(s,"bytes",5) == 0) - { - PerlIOBase(f)->flags &= ~PERLIO_F_UTF8; - } - else + SV *layer = PerlIO_find_layer(s,llen); + if (layer) { - STRLEN len = ((as) ? as : e)-s; - SV *layer = PerlIO_find_layer(s,len); - if (layer) + PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer))); + if (tab) { - PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer))); - if (tab) - { - if (as && (ae == Nullch)) { - ae = e; - Perl_warn(aTHX_ "perlio: argument list not closed for layer \"%.*s\"",(int)(e - s),s); - } - len = (as) ? (ae-(as++)-1) : 0; - if (!PerlIO_push(f,tab,mode,as,len)) - return -1; - } + if (!PerlIO_push(f,tab,mode,as,alen)) + return -1; } - else - Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)len,s); } + else + Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)llen,s); } s = e; } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index cd91df7..122f5ea 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -16,7 +16,7 @@ desperation): (A) An alien error message (not generated by Perl). The majority of messages from the first three classifications above -(W, D & S) can be controlled using the C pragma. +(W, D & S) can be controlled using the C pragma. If a message can be controlled by the C pragma, its warning category is included with the classification letter in the description @@ -656,7 +656,7 @@ If you're getting this error from a here-document, you may have included unseen whitespace before or after your closing tag. A good programmer's editor will have a way to help you find these characters. -=item Can't find %s property definition %s +=item Can't find %s property definition %s (F) You may have tried to use C<\p> which means a Unicode property for example \p{Lu} is all uppercase letters. Escape the C<\p>, either @@ -759,7 +759,7 @@ directly -- C<< local $ar->[$ar->[0]{'key'}] >>. (F) You said something like C, which Perl can't currently handle, because when it goes to restore the old value of whatever $ref pointed to after the scope of the local() is finished, it can't be sure -that $ref will still be a reference. +that $ref will still be a reference. =item Can't locate %s @@ -896,7 +896,7 @@ or grep(). You can usually double the curlies to get the same effect though, because the inner curlies will be considered a block that loops once. See L. -=item Can't remove %s: %s, skipping file +=item Can't remove %s: %s, skipping file (S inplace) You requested an inplace edit without creating a backup file. Perl was unable to remove the original file to replace it with @@ -1136,7 +1136,7 @@ workarounds. =item Copy method did not return a reference -(F) The method which overloads "=" is buggy. See +(F) The method which overloads "=" is buggy. See L. =item CORE::%s is not a keyword @@ -1179,13 +1179,13 @@ which case it indicates something else. (D deprecated) defined() is not usually useful on arrays because it checks for an undefined I value. If you want to see if the -array is empty, just use C for example. +array is empty, just use C for example. =item defined(%hash) is deprecated (D deprecated) defined() is not usually useful on hashes because it checks for an undefined I value. If you want to see if the hash -is empty, just use C for example. +is empty, just use C for example. =item Delimiter for here document is too long @@ -1680,7 +1680,7 @@ shows in the regular expression about where the problem was discovered. (W syntax) You've run afoul of the rule that says that any list operator followed by parentheses turns into a function, with all the list -operators arguments found inside the parentheses. See +operators arguments found inside the parentheses. See L. =item Invalid %s attribute: %s @@ -1915,7 +1915,7 @@ is aliased to a constant in the look I: $x = 1; foreach my $n ($x, 2) { $n *= 2; # modifies the $x, but fails on attempt to modify the 2 - } + } =item Modification of non-creatable array value attempted, %s @@ -2555,7 +2555,7 @@ was string. =item panic: utf16_to_utf8: odd bytelen (P) Something tried to call utf16_to_utf8 with an odd (as opposed -to even) byte length. +to even) byte length. =item Parentheses missing around "%s" list @@ -2604,13 +2604,19 @@ L section B. =item perlio: argument list not closed for layer "%s" -(S) When pusing a layer with arguments onto the Perl I/O system you forgot +(S) When pushing a layer with arguments onto the Perl I/O system you forgot the ) that closes the argument list. (Layers take care of transforming -data between external and internal representations.) Perl assumed that -the argument list finished at the next : or the end of the layer -specification. If your program didn't explicitly request the failing -operation, it may be the result of the value of the environment variable -PERLIO. +data between external and internal representations.) Perl stopped parsing +the layer list at this point and did not attempt to push this layer. +If your program didn't explicitly request the failing operation, it may be +the result of the value of the environment variable PERLIO. + +=item perlio: invalid separator character %s in attribute list + +(S) When pushing layers onto the Perl I/O system, something other than a +colon or whitespace was seen between the elements of an layer list. +If the previous attribute had a parenthesised parameter list, perhaps that +list was terminated too soon. =item perlio: unknown layer "%s" @@ -3001,7 +3007,7 @@ where the problem was discovered. See L. (F) You used a regular expression extension that doesn't make sense. The << HERE shows in the regular expression about -where the problem was discovered. +where the problem was discovered. See L. =item Sequence (?#... not terminated in regex m/%s/ @@ -3740,7 +3746,7 @@ defined B feature. Use an explicit printf() or sprintf() instead. isn't what you mean, because references tend to be huge numbers which take you out of memory, and so usually indicates programmer error. -If you really do mean it, explicitly numify your reference, like so: +If you really do mean it, explicitly numify your reference, like so: C<$array[0+$ref]> =item Use of reserved word "%s" is deprecated