Integrate perlio:

[  7555]
Fix read from STDERR on raw unix layer for Solaris where fd 2 is
open RDWR so does not fail. (pragma/warnings 303 again...)

[  7554]
Fix case where ungetc(f,EOF) was allowed.
Move PerlIO_ungetc() near PerlIO_putc()/PerlIO_getc() in the file
so we can see similarities.
Use types more carefully and a STDCHAR array in hope that this will
fix Jarkko's 64bit machine.

p4raw-link: @7555 on //depot/perlio: 8f24bd7931e1129a30ea0a951e81eecafa42f53b
p4raw-link: @7554 on //depot/perlio: 313ca112ae76354c03e7aff0a3e35062e8173ef0

p4raw-id: //depot/perl@7558

1 files changed, 26 insertions, 12 deletions

diff --git a/perlio.c b/perlio.c
index 03c93e136e..2c61003012 100644
--- a/perlio.c
+++ b/perlio.c
@@ -372,7 +372,7 @@ PerlIO_default_layer(I32 n)
            av_push(PerlIO_layer_av,SvREFCNT_inc(layer));
           }
          else
-          Perl_croak(aTHX_ "Unknown layer %.*s",(e-s),s);
+          Perl_warn(aTHX_ "Unknown layer %.*s",(e-s),s);
          s = e;
         }
       }
@@ -513,14 +513,11 @@ PerlIO_read(PerlIO *f, void *vbuf, Size_t count)
  return (*PerlIOBase(f)->tab->Read)(f,vbuf,count);
 }
 
-#undef PerlIO_ungetc
-int
-PerlIO_ungetc(PerlIO *f, int ch)
+#undef PerlIO_unread
+SSize_t
+PerlIO_unread(PerlIO *f, const void *vbuf, Size_t count)
 {
- STDCHAR buf = ch;
- if ((*PerlIOBase(f)->tab->Unread)(f,&buf,1) == 1)
-  return ch;
- return -1;
+ return (*PerlIOBase(f)->tab->Unread)(f,vbuf,count);
 }
 
 #undef PerlIO_write
@@ -912,6 +909,8 @@ SSize_t
 PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
 {
  int fd = PerlIOSelf(f,PerlIOUnix)->fd;
+ if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
+  return 0;
  while (1)
   {
    SSize_t len = read(fd,vbuf,count);
@@ -1775,11 +1774,26 @@ PerlIO_getname(PerlIO *f, char *buf)
 int
 PerlIO_getc(PerlIO *f)
 {
- STDCHAR buf;
- int count = PerlIO_read(f,&buf,1);
+ STDCHAR buf[1];
+ SSize_t count = PerlIO_read(f,buf,1);
  if (count == 1)
-  return (unsigned char) buf;
- return -1;
+  {
+   return (unsigned char) buf[0];
+  }
+ return EOF;
+}
+
+#undef PerlIO_ungetc
+int
+PerlIO_ungetc(PerlIO *f, int ch)
+{
+ if (ch != EOF)
+  {
+   STDCHAR buf = ch;
+   if (PerlIO_unread(f,&buf,1) == 1)
+    return ch;
+  }
+ return EOF;
 }
 
 #undef PerlIO_putc