This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Apply the spirit of patch from Nicholas Clark:
authorNicholas Clark <nick@ccl4.org>
Mon, 12 Feb 2001 16:43:51 +0000 (16:43 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Sun, 18 Feb 2001 19:10:34 +0000 (19:10 +0000)
       Subject: [PATCH] Re: extensions that provide layers
       Message-Id: <20010212164350.Q3652@plum.flirble.org>

p4raw-id: //depot/perlio@8830

perlio.c
pod/perldiag.pod

index 7d95735..dd1c9ce 100644 (file)
--- 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;
       }
index cd91df7..122f5ea 100644 (file)
@@ -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<warnings> pragma. 
+(W, D & S) can be controlled using the C<warnings> pragma.
 
 If a message can be controlled by the C<warnings> 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<local $$ref>, 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<perlfunc/redo>.
 
-=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<overload/Copy Constructor>.
 
 =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<scalar> value.  If you want to see if the
-array is empty, just use C<if (@array) { # not empty }> for example.  
+array is empty, just use C<if (@array) { # not empty }> for example.
 
 =item defined(%hash) is deprecated
 
 (D deprecated) defined() is not usually useful on hashes because it
 checks for an undefined I<scalar> value.  If you want to see if the hash
-is empty, just use C<if (%hash) { # not empty }> for example.  
+is empty, just use C<if (%hash) { # not empty }> 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<perlop/Terms and List Operators (Leftward)>.
 
 =item Invalid %s attribute: %s
@@ -1915,7 +1915,7 @@ is aliased to a constant in the look I<LIST>:
         $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<perllocale> section B<LOCALE PROBLEMS>.
 
 =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<perlre>.
 
 (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<perlre>.
 
 =item Sequence (?#... not terminated in regex m/%s/
@@ -3740,7 +3746,7 @@ defined B<awk> 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