This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate perlio:
authorJarkko Hietaniemi <jhi@iki.fi>
Tue, 14 Nov 2000 17:54:56 +0000 (17:54 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Tue, 14 Nov 2000 17:54:56 +0000 (17:54 +0000)
[  7684]
PerlIO #include and #ifdef re-work.

p4raw-link: @7684 on //depot/perlio: 76ced9add7b621dfc9d4ecb534aeea8e131a418a

p4raw-id: //depot/perl@7685

28 files changed:
MANIFEST
doio.c
doop.c
ext/IO/lib/IO/Handle.pm
ext/IO/lib/IO/Seekable.pm
ext/SDBM_File/Makefile.PL
ext/re/hints/MSWin32.pl [new file with mode: 0644]
lib/ExtUtils/MM_Unix.pm
lib/perl5db.pl
makedef.pl
perl.h
perlapi.c
perlio.c
pp.c
pp_sys.c
t/lib/tie-refhash.t
toke.c
utf8.c
utf8.h
win32/Makefile
win32/bin/mdelete.bat [new file with mode: 0644]
win32/config.bc
win32/config.gc
win32/config.vc
win32/makefile.mk
win32/win32.c
win32/win32.h
win32/win32sck.c

index 6d71e69..e26d81f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -437,6 +437,7 @@ ext/attrs/attrs.xs  attrs extension external subroutines
 ext/re/Makefile.PL     re extension makefile writer
 ext/re/hints/aix.pl    Hints for re for named architecture
 ext/re/hints/mpeix.pl  Hints for re for named architecture
+ext/re/hints/MSWin32.pl        Hints for re for named architecture
 ext/re/re.pm           re extension Perl module
 ext/re/re.xs           re extension external subroutines
 ext/util/make_ext      Used by Makefile to execute extension Makefiles
@@ -1724,6 +1725,7 @@ warnings.h                The warning numbers
 warnings.pl            Program to write warnings.h and lib/warnings.pm
 win32/Makefile         Win32 makefile for NMAKE (Visual C++ build)
 win32/bin/exetype.pl   Set executable type to CONSOLE or WINDOWS
+win32/bin/mdelete.bat  multifile delete
 win32/bin/perlglob.pl  Win32 globbing
 win32/bin/pl2bat.pl    wrap perl scripts into batch files
 win32/bin/runperl.pl   run perl script via batch file namesake
diff --git a/doio.c b/doio.c
index 87e53a4..e4724ef 100644 (file)
--- a/doio.c
+++ b/doio.c
 #  include <unistd.h>
 #endif
 
-#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
-# include <sys/socket.h>
-# if defined(USE_SOCKS) && defined(I_SOCKS)
-#   if !defined(INCLUDE_PROTOTYPES)
-#       define INCLUDE_PROTOTYPES /* for <socks.h> */
-#       define PERL_SOCKS_NEED_PROTOTYPES
-#   endif
-#   include <socks.h>
-#   ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
-#       undef INCLUDE_PROTOTYPES
-#       undef PERL_SOCKS_NEED_PROTOTYPES
-#   endif 
-# endif 
-# ifdef I_NETBSD
-#  include <netdb.h>
-# endif
-# ifndef ENOTSOCK
-#  ifdef I_NET_ERRNO
-#   include <net/errno.h>
-#  endif
-# endif
-#endif
-
 bool
 Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
             int rawmode, int rawperm, PerlIO *supplied_fp)
diff --git a/doop.c b/doop.c
index 3d22eb4..a2990ce 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -968,10 +968,10 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
        switch (optype) {
        case OP_BIT_AND:
            while (lulen && rulen) {
-               luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANY);
+               luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
                lc += ulen;
                lulen -= ulen;
-               ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANY);
+               ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
                rc += ulen;
                rulen -= ulen;
                duc = luc & ruc;
@@ -983,10 +983,10 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
            break;
        case OP_BIT_XOR:
            while (lulen && rulen) {
-               luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANY);
+               luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
                lc += ulen;
                lulen -= ulen;
-               ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANY);
+               ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
                rc += ulen;
                rulen -= ulen;
                duc = luc ^ ruc;
@@ -995,10 +995,10 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
            goto mop_up_utf;
        case OP_BIT_OR:
            while (lulen && rulen) {
-               luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANY);
+               luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
                lc += ulen;
                lulen -= ulen;
-               ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANY);
+               ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
                rc += ulen;
                rulen -= ulen;
                duc = luc | ruc;
index 9266f33..fb754a6 100644 (file)
@@ -157,15 +157,15 @@ operates on the file descriptor (similar to sysread, sysseek and
 systell). This means that any data held at the perlio api level will not
 be synchronized. To synchronize data that is buffered at the perlio api
 level you must use the flush method. C<sync> is not implemented on all
-platforms. Returns 0 on success, -1 on error, -1 for an invalid handle.
-See L<fsync(3c)>.
+platforms. Returns "0 but true" on success, C<undef> on error, C<undef>
+for an invalid handle. See L<fsync(3c)>.
 
 =item $io->flush
 
 C<flush> causes perl to flush any buffered data at the perlio api level.
 Any unread data in the buffer will be discarded, and any unwritten data
-will be written to the underlying file descriptor. Returns 0 on success,
-or a negative value on error.
+will be written to the underlying file descriptor. Returns "0 but true"
+on success, C<undef> on error.
 
 =item $io->printflush ( ARGS )
 
@@ -200,7 +200,8 @@ the order of global destruction is undefined, so even if your buffer
 variable remains in scope until program termination, it may be undefined
 before the file IO::Handle is closed. Note that you need to import the
 constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
-returns nothing, setvbuf returns 0 on success, -1 on failure.
+returns nothing. setvbuf returns "0 but true", on success, C<undef> on
+failure.
 
 Lastly, there is a special method for working under B<-T> and setuid/gid
 scripts:
index 77e0c3a..243a971 100644 (file)
@@ -31,7 +31,7 @@ using C's ftell() function.
 =item $io->setpos
 
 Uses the value of a previous getpos call to return to a previously visited
-position. Returns 0 on success, -1 on failure.
+position. Returns "0 but true" on success, C<undef> on failure.
 
 =back
   
index a1debb9..132bdad 100644 (file)
@@ -1,4 +1,5 @@
 use ExtUtils::MakeMaker;
+use Config;
 
 # The existence of the ./sdbm/Makefile.PL file causes MakeMaker
 # to automatically include Makefile code for the targets
@@ -21,18 +22,26 @@ WriteMakefile(
 
 sub MY::postamble {
   if ($^O =~ /MSWin32/ && Win32::IsWin95()) {
-    # XXX: dmake-specific, like rest of Win95 port
-    return
-    '
+       if ($Config{'make'} =~ /dmake/i) {
+           # dmake-specific
+           return <<EOT;
 $(MYEXTLIB): sdbm/Makefile
 @[
        cd sdbm
        $(MAKE) all
        cd ..
 ]
-';
-  }
-  elsif ($^O ne 'VMS') {
+EOT
+       } elsif ($Config{'make'} =~ /nmake/i) {
+           #
+           return <<EOT;
+$(MYEXTLIB): sdbm/Makefile
+       cd sdbm
+       $(MAKE) all
+       cd ..
+EOT
+       } 
+} elsif ($^O ne 'VMS') {
     '
 $(MYEXTLIB): sdbm/Makefile
        cd sdbm && $(MAKE) all
diff --git a/ext/re/hints/MSWin32.pl b/ext/re/hints/MSWin32.pl
new file mode 100644 (file)
index 0000000..3ac0fda
--- /dev/null
@@ -0,0 +1,18 @@
+# Add explicit link to deb.o to pick up _Perl_deb symbol which is not\r
+# mentioned in perl56.lib in non DEBUGGING builds\r
+# Taken lock, stock, and barrel from hints/aix.pl\r
+#  -- BKS, 11-11-2000\r
+\r
+if ($^O =~ /MSWin32/) {\r
+    $self->{OBJECT} .= ' ../../deb$(OBJ_EXT)';\r
+}\r
+\r
+# Add explicit link to deb.o to pick up _Perl_deb symbol which is not\r
+# mentioned in perl56.lib in non DEBUGGING builds\r
+# Taken lock, stock, and barrel from hints/aix.pl\r
+#  -- BKS, 11-11-2000\r
+\r
+if ($^O =~ /MSWin32/) {\r
+    $self->{OBJECT} .= ' ../../deb$(OBJ_EXT)';\r
+}\r
+\r
index 2783965..f538818 100644 (file)
@@ -3288,8 +3288,9 @@ sub subdir_x {
     my($self, $subdir) = @_;
     my(@m);
     if ($Is_Win32 && Win32::IsWin95()) {
-       # XXX: dmake-specific, like rest of Win95 port
-       return <<EOT;
+       if ($Config{'make'} =~ /dmake/i) {
+           # dmake-specific
+           return <<EOT;
 subdirs ::
 @[
        cd $subdir
@@ -3297,8 +3298,16 @@ subdirs ::
        cd ..
 ]
 EOT
-    }
-    else {
+        } elsif ($Config{'make'} =~ /nmake/i) {
+           # nmake-specific
+           return <<EOT;
+subdirs ::
+       cd $subdir
+       \$(MAKE) all \$(PASTHRU)
+       cd ..
+EOT
+       }
+    } else {
        return <<EOT;
 
 subdirs ::
index 836e559..63b4381 100644 (file)
@@ -25,7 +25,7 @@ $header = "perl5db.pl version $VERSION";
 # if caller() is called from the package DB, it provides some
 # additional data.
 #
-# The array @{$main::{'_<'.$filename} is the line-by-line contents of
+# The array @{$main::{'_<'.$filename}} is the line-by-line contents of
 # $filename.
 #
 # The hash %{'_<'.$filename} contains breakpoints and action (it is
index a02a298..e576245 100644 (file)
@@ -73,7 +73,8 @@ if ($PLATFORM eq 'aix') {
 }
 elsif ($PLATFORM eq 'win32') {
     $CCTYPE = "MSVC" unless defined $CCTYPE;
-    foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, $pp_sym, $globvar_sym) {
+    foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym,
+               $pp_sym, $globvar_sym, $perlio_sym) {
        s!^!..\\!;
     }
 }
@@ -572,6 +573,8 @@ while (<DATA>) {
 
 if ($PLATFORM eq 'win32') {
     foreach my $symbol (qw(
+                           setuid
+                           setgid
                            boot_DynaLoader
                            Perl_init_os_extras
                            Perl_thread_create
@@ -579,35 +582,6 @@ if ($PLATFORM eq 'win32') {
                            RunPerl
                            win32_errno
                            win32_environ
-                           win32_stdin
-                           win32_stdout
-                           win32_stderr
-                           win32_ferror
-                           win32_feof
-                           win32_strerror
-                           win32_fprintf
-                           win32_printf
-                           win32_vfprintf
-                           win32_vprintf
-                           win32_fread
-                           win32_fwrite
-                           win32_fopen
-                           win32_fdopen
-                           win32_freopen
-                           win32_fclose
-                           win32_fputs
-                           win32_fputc
-                           win32_ungetc
-                           win32_getc
-                           win32_fileno
-                           win32_clearerr
-                           win32_fflush
-                           win32_ftell
-                           win32_fseek
-                           win32_fgetpos
-                           win32_fsetpos
-                           win32_rewind
-                           win32_tmpfile
                            win32_abort
                            win32_fstat
                            win32_stat
@@ -678,17 +652,6 @@ if ($PLATFORM eq 'win32') {
                            win32_getenv
                            win32_putenv
                            win32_perror
-                           win32_setbuf
-                           win32_setvbuf
-                           win32_flushall
-                           win32_fcloseall
-                           win32_fgets
-                           win32_gets
-                           win32_fgetc
-                           win32_putc
-                           win32_puts
-                           win32_getchar
-                           win32_putchar
                            win32_malloc
                            win32_calloc
                            win32_realloc
@@ -720,6 +683,47 @@ if ($PLATFORM eq 'win32') {
                            win32_getpid
                            win32_crypt
                            win32_dynaload
+
+                           win32_stdin
+                           win32_stdout
+                           win32_stderr
+                           win32_ferror
+                           win32_feof
+                           win32_strerror
+                           win32_fprintf
+                           win32_printf
+                           win32_vfprintf
+                           win32_vprintf
+                           win32_fread
+                           win32_fwrite
+                           win32_fopen
+                           win32_fdopen
+                           win32_freopen
+                           win32_fclose
+                           win32_fputs
+                           win32_fputc
+                           win32_ungetc
+                           win32_getc
+                           win32_fileno
+                           win32_clearerr
+                           win32_fflush
+                           win32_ftell
+                           win32_fseek
+                           win32_fgetpos
+                           win32_fsetpos
+                           win32_rewind
+                           win32_tmpfile
+                           win32_setbuf
+                           win32_setvbuf
+                           win32_flushall
+                           win32_fcloseall
+                           win32_fgets
+                           win32_gets
+                           win32_fgetc
+                           win32_putc
+                           win32_puts
+                           win32_getchar
+                           win32_putchar
                           ))
     {
        try_symbol($symbol);
diff --git a/perl.h b/perl.h
index 6f822dc..f932198 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -709,10 +709,32 @@ typedef struct perl_mstats perl_mstats_t;
 #endif
 
 #include <errno.h>
-#ifdef HAS_SOCKET
-#   ifdef I_NET_ERRNO
-#     include <net/errno.h>
-#   endif
+
+#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
+# include <sys/socket.h>
+# if defined(USE_SOCKS) && defined(I_SOCKS)
+#   if !defined(INCLUDE_PROTOTYPES)
+#       define INCLUDE_PROTOTYPES /* for <socks.h> */
+#       define PERL_SOCKS_NEED_PROTOTYPES
+#   endif
+#   include <socks.h>
+#   ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
+#       undef INCLUDE_PROTOTYPES
+#       undef PERL_SOCKS_NEED_PROTOTYPES
+#   endif
+# endif 
+# ifdef I_NETDB
+#  include <netdb.h>
+# endif
+# ifndef ENOTSOCK
+#  ifdef I_NET_ERRNO
+#   include <net/errno.h>
+#  endif
+# endif
+#endif
+
+#ifdef SETERRNO
+# undef SETERRNO  /* SOCKS might have defined this */
 #endif
 
 #ifdef VMS
index d71ac49..a9dd2f0 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -2237,21 +2237,21 @@ Perl_init_i18nl14n(pTHXo_ int printwarn)
 
 #undef  Perl_new_collate
 void
-Perl_new_collate(pTHXo_ const char* newcoll)
+Perl_new_collate(pTHXo_ char* newcoll)
 {
     ((CPerlObj*)pPerl)->Perl_new_collate(newcoll);
 }
 
 #undef  Perl_new_ctype
 void
-Perl_new_ctype(pTHXo_ const char* newctype)
+Perl_new_ctype(pTHXo_ char* newctype)
 {
     ((CPerlObj*)pPerl)->Perl_new_ctype(newctype);
 }
 
 #undef  Perl_new_numeric
 void
-Perl_new_numeric(pTHXo_ const char* newcoll)
+Perl_new_numeric(pTHXo_ char* newcoll)
 {
     ((CPerlObj*)pPerl)->Perl_new_numeric(newcoll);
 }
index 7dc895c..da1d8ac 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -108,9 +108,9 @@ PerlIO_debug(char *fmt,...)
  static int dbg = 0;
  if (!dbg)
   {
-   char *s = getenv("PERLIO_DEBUG");
+   char *s = PerlEnv_getenv("PERLIO_DEBUG");
    if (s && *s)
-    dbg = open(s,O_WRONLY|O_CREAT|O_APPEND,0666);
+    dbg = PerlLIO_open3(s,O_WRONLY|O_CREAT|O_APPEND,0666);
    else
     dbg = -1;
   }
@@ -129,7 +129,7 @@ PerlIO_debug(char *fmt,...)
    Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
 
    s = SvPV(sv,len);
-   write(dbg,s,len);
+   PerlLIO_write(dbg,s,len);
    va_end(ap);
    SvREFCNT_dec(sv);
   }
@@ -284,7 +284,7 @@ PerlIO_default_layer(I32 n)
  int len;
  if (!PerlIO_layer_hv)
   {
-   char *s  = getenv("PERLIO");
+   char *s  = PerlEnv_getenv("PERLIO");
    newXS("perlio::import",XS_perlio_import,__FILE__);
    newXS("perlio::unimport",XS_perlio_unimport,__FILE__);
    PerlIO_layer_hv = get_hv("perlio::layers",GV_ADD|GV_ADDMULTI);
@@ -300,13 +300,13 @@ PerlIO_default_layer(I32 n)
     {
      while (*s)
       {
-       while (*s && isspace((unsigned char)*s))
+       while (*s && isSPACE((unsigned char)*s))
         s++;
        if (*s)
         {
          char *e = s;
          SV *layer;
-         while (*e && !isspace((unsigned char)*e))
+         while (*e && !isSPACE((unsigned char)*e))
           e++;
          layer = PerlIO_find_layer(s,e-s);
          if (layer)
@@ -836,7 +836,7 @@ PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode)
  int oflags = PerlIOUnix_oflags(mode);
  if (oflags != -1)
   {
-   int fd = open(path,oflags,0666);
+   int fd = PerlLIO_open3(path,oflags,0666);
    if (fd >= 0)
     {
      PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix);
@@ -857,7 +857,7 @@ PerlIOUnix_reopen(const char *path, const char *mode, PerlIO *f)
   (*PerlIOBase(f)->tab->Close)(f);
  if (oflags != -1)
   {
-   int fd = open(path,oflags,0666);
+   int fd = PerlLIO_open3(path,oflags,0666);
    if (fd >= 0)
     {
      s->fd = fd;
@@ -877,7 +877,7 @@ PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
   return 0;
  while (1)
   {
-   SSize_t len = read(fd,vbuf,count);
+   SSize_t len = PerlLIO_read(fd,vbuf,count);
    if (len >= 0 || errno != EINTR)
     {
      if (len < 0)
@@ -895,7 +895,7 @@ PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count)
  int fd = PerlIOSelf(f,PerlIOUnix)->fd;
  while (1)
   {
-   SSize_t len = write(fd,vbuf,count);
+   SSize_t len = PerlLIO_write(fd,vbuf,count);
    if (len >= 0 || errno != EINTR)
     {
      if (len < 0)
@@ -908,7 +908,7 @@ PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count)
 IV
 PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
 {
- Off_t new = lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence);
+ Off_t new = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence);
  PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
  return (new == (Off_t) -1) ? -1 : 0;
 }
@@ -916,7 +916,7 @@ PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
 Off_t
 PerlIOUnix_tell(PerlIO *f)
 {
- return lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
+ return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
 }
 
 IV
@@ -924,7 +924,7 @@ PerlIOUnix_close(PerlIO *f)
 {
  int fd = PerlIOSelf(f,PerlIOUnix)->fd;
  int code = 0;
- while (close(fd) != 0)
+ while (PerlLIO_close(fd) != 0)
   {
    if (errno != EINTR)
     {
@@ -2168,7 +2168,7 @@ PerlIO_tmpfile(void)
     {
      PerlIOBase(f)->flags |= PERLIO_F_TEMP;
     }
-   unlink(SvPVX(sv));
+   PerlLIO_unlink(SvPVX(sv));
    SvREFCNT_dec(sv);
   }
  return f;
diff --git a/pp.c b/pp.c
index 2a414b8..6001165 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1486,7 +1486,7 @@ PP(pp_complement)
 
          send = tmps + len;
          while (tmps < send) {
-           UV c = utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY);
+           UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
            tmps += UTF8SKIP(tmps);
            targlen += UNISKIP(~c);
            nchar++;
@@ -1500,7 +1500,7 @@ PP(pp_complement)
          if (nwide) {
              Newz(0, result, targlen + 1, U8);
              while (tmps < send) {
-                 UV c = utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY);
+                 UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
                  tmps += UTF8SKIP(tmps);
                  result = uv_to_utf8(result, ~c);
              }
index 4b8bfce..43b3f66 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -54,33 +54,10 @@ extern "C" int syscall(unsigned long,...);
 # include <sys/resource.h>
 #endif
 
-#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
-# include <sys/socket.h>
-# if defined(USE_SOCKS) && defined(I_SOCKS)
-#   if !defined(INCLUDE_PROTOTYPES)
-#       define INCLUDE_PROTOTYPES /* for <socks.h> */
-#       define PERL_SOCKS_NEED_PROTOTYPES
-#   endif
-#   include <socks.h>
-#   ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
-#       undef INCLUDE_PROTOTYPES
-#       undef PERL_SOCKS_NEED_PROTOTYPES
-#   endif 
-# endif
-# ifdef I_NETDB
-#  include <netdb.h>
-# endif
-# ifndef ENOTSOCK
-#  ifdef I_NET_ERRNO
-#   include <net/errno.h>
-#  endif
-# endif
-#endif
-
 #ifdef HAS_SELECT
-#ifdef I_SYS_SELECT
-#include <sys/select.h>
-#endif
+# ifdef I_SYS_SELECT
+#  include <sys/select.h>
+# endif
 #endif
 
 /* XXX Configure test needed.
index a82c19c..d80b2e1 100644 (file)
@@ -1,19 +1,19 @@
 #!/usr/bin/perl -w
-#
+# 
 # Basic test suite for Tie::RefHash and Tie::RefHash::Nestable.
-#
+# 
 # The testing is in two parts: first, run lots of tests on both a tied
 # hash and an ordinary un-tied hash, and check they give the same
 # answer.  Then there are tests for those cases where the tied hashes
 # should behave differently to normal hashes, that is, when using
 # references as keys.
-#
+# 
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '.';
+    @INC = '.'; 
     push @INC, '../lib';
-}
+}    
 
 use strict;
 use Tie::RefHash;
@@ -28,7 +28,7 @@ my $ref = []; my $ref1 = [];
 # on a tied hash and on a normal hash, and checking that the results
 # are the same.  This does of course assume that Perl hashes are not
 # buggy :-)
-#
+# 
 my @tests = standard_hash_tests();
 
 my @ordinary_results = runtests(\@tests, undef);
@@ -40,13 +40,13 @@ foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') {
     foreach my $i (0 .. $#ordinary_results) {
         my ($or, $ow, $oe) = @{$ordinary_results[$i]};
         my ($tr, $tw, $te) = @{$tied_results[$i]};
-
+        
         my $ok = 1;
         local $^W = 0;
         $ok = 0 if (defined($or) != defined($tr)) or ($or ne $tr);
         $ok = 0 if (defined($ow) != defined($tw)) or ($ow ne $tw);
         $ok = 0 if (defined($oe) != defined($te)) or ($oe ne $te);
-
+        
         if (not $ok) {
             print STDERR
               "failed for $class: $tests[$i]\n",
@@ -127,7 +127,7 @@ exit();
 
 # Print 'ok X' if true, 'not ok X' if false
 # Uses global $currtest.
-#
+# 
 sub test {
     my $t = shift;
     print 'not ' if not $t;
@@ -135,7 +135,7 @@ sub test {
 }
 
 
-# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string.
+# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. 
 sub dumped {
     my $s = shift;
     my $d = Dumper($s);
@@ -148,7 +148,7 @@ sub dumped {
 # Crudely dump a hash into a canonical string representation (because
 # hash keys can appear in any order, Data::Dumper may give different
 # strings for the same hash).
-#
+# 
 sub dumph {
     my $h = shift;
     my $r = '';
@@ -159,17 +159,17 @@ sub dumph {
 }
 
 # Run the tests and give results.
-#
+# 
 # Parameters: reference to list of tests to run
 #             name of class to use for tied hash, or undef if not tied
-#
+# 
 # Returns: list of [R, W, E] tuples, one for each test.
 # R is the return value from running the test, W any warnings it gave,
 # and E any exception raised with 'die'.  E and W will be tidied up a
 # little to remove irrelevant details like line numbers :-)
-#
+# 
 # Will also run a few of its own 'ok N' tests.
-#
+# 
 sub runtests {
     my ($tests, $class) = @_;
     my @r;
@@ -215,14 +215,14 @@ sub runtests {
 
 # Things that should work just the same for an ordinary hash and a
 # Tie::RefHash.
-#
+# 
 # Each test is a code string to be eval'd, it should do something with
 # %h and give a scalar return value.  The global $ref and $ref1 may
 # also be used.
-#
+# 
 # One thing we don't test is that the ordering from 'keys', 'values'
 # and 'each' is the same.  You can't reasonably expect that.
-#
+# 
 sub standard_hash_tests {
     my @r;
 
@@ -234,12 +234,12 @@ sub standard_hash_tests {
     { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) }
 END
   ;
-
+    
     # Tests on the existence of the element 'foo'
     my $FOO_TESTS = <<'END'
     defined $h{foo};
     exists $h{foo};
-    $h{foo};
+    $h{foo};    
 END
   ;
 
@@ -278,7 +278,7 @@ END
   ;
         }
     }
-
+    
     # Test hash slices
     my @slicetests;
     @slicetests = split /\n/, <<'END'
diff --git a/toke.c b/toke.c
index 458e258..b48577e 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1332,7 +1332,7 @@ S_scan_const(pTHX_ char *start)
            UV uv;
 
            uv = utf8_to_uv((U8*)s, send - s, &len, UTF8_CHECK_ONLY);
-           if (len == 1) {
+           if (len == (STRLEN)-1) {
                /* Illegal UTF8 (a high-bit byte), make it valid. */
                char *old_pvx = SvPVX(sv);
                /* need space for one extra char (NOTE: SvCUR() not set here) */
diff --git a/utf8.c b/utf8.c
index 6ddf42b..a54726f 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -312,12 +312,12 @@ malformed:
 
     if (flags & UTF8_CHECK_ONLY) {
        if (retlen)
-           *retlen = len;
+           *retlen = -1;
        return 0;
     }
 
     if (retlen)
-       *retlen = -1;
+       *retlen = expectlen ? expectlen : len;
 
     return UNICODE_REPLACEMENT_CHARACTER;
 }
diff --git a/utf8.h b/utf8.h
index dc93e95..269ad3e 100644 (file)
--- a/utf8.h
+++ b/utf8.h
@@ -41,6 +41,8 @@ END_EXTERN_C
 #define UTF8_ALLOW_BOM                 0x0020
 #define UTF8_ALLOW_FFFF                        0x0040
 #define UTF8_ALLOW_LONG                        0x0080
+#define UTF8_ALLOW_ANYUV               (UTF8_ALLOW_FE_FF|UTF8_ALLOW_FFFF \
+                                       |UTF8_ALLOW_BOM|UTF8_ALLOW_SURROGATE)
 #define UTF8_ALLOW_ANY                 0x00ff
 #define UTF8_CHECK_ONLY                        0x0100
 
index af11990..fafbd27 100644 (file)
@@ -63,6 +63,12 @@ INST_ARCH    = \$(ARCHNAME)
 #USE_IMP_SYS   = define
 
 #
+# uncomment to enable the experimental PerlIO I/O subsystem.
+# This is currently incompatible with USE_MULTI, USE_ITHREADS,
+# and USE_IMP_SYS
+#USE_PERLIO    = define
+
+#
 # WARNING! This option is deprecated and will eventually go away (enable
 # USE_ITHREADS instead).
 #
@@ -273,10 +279,18 @@ ARCHNAME  = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread
 !IF "$(USE_MULTI)" == "define"
 ARCHNAME       = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi
 !ELSE
+!IF "$(USE_PERLIO)" == "define"
+ARCHNAME       = MSWin32-$(PROCESSOR_ARCHITECTURE)-perlio
+!ELSE
 ARCHNAME       = MSWin32-$(PROCESSOR_ARCHITECTURE)
 !ENDIF
 !ENDIF
 !ENDIF
+!ENDIF
+
+!IF "$(USE_PERLIO)" == "define"
+BUILDOPT       = $(BUILDOPT) -DUSE_PERLIO
+!ENDIF
 
 !IF "$(USE_ITHREADS)" == "define"
 ARCHNAME       = $(ARCHNAME)-thread
@@ -465,6 +479,8 @@ RCOPY               = xcopy /f /r /i /e /d
 NOOP           = @echo
 NULL           =
 
+DEL            = bin\mdelete.bat
+
 #
 # filenames given to xsubpp must have forward slashes (since it puts
 # full pathnames in #line strings)
@@ -691,8 +707,9 @@ CFG_VARS    =                                       \
                "INST_ARCH=$(INST_ARCH)"                \
                "archname=$(ARCHNAME)"                  \
                "cc=$(CC)"                              \
-               "ccflags=$(OPTIMIZE:"=\") $(DEFINES) $(BUILDOPT)"       \
-               "cf_email=$(EMAIL)"                     \
+               "ld=$(LINK32)"                          \
+               "ccflags=-nologo -Gf -W3 $(OPTIMIZE:"=\") $(DEFINES) $(BUILDOPT)"       \
+               "cf_email=$(EMAIL)"                     \
                "d_crypt=$(D_CRYPT)"                    \
                "d_mymalloc=$(PERL_MALLOC)"             \
                "libs=$(LIBFILES)"                      \
@@ -753,14 +770,16 @@ regen_config_h:
        rename config.h $(CFGH_TMPL)
 
 $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
-       cd .. && miniperl configpm
+       cd .. 
+       miniperl configpm
+       cd win32
        if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
        $(XCOPY) ..\*.h $(COREDIR)\*.*
        $(XCOPY) *.h $(COREDIR)\*.*
        $(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
        $(RCOPY) include $(COREDIR)\*.*
-       $(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" \
-           || $(MAKE) /$(MAKEFLAGS) $(CONFIGPM)
+       -$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)"
+       if errorlevel 1 $(MAKE) /$(MAKEFLAGS) $(CONFIGPM)
 
 $(MINIPERL) : $(MINIDIR) $(MINI_OBJ)
        $(LINK32) -subsystem:console -out:$@ @<<
@@ -803,7 +822,9 @@ $(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES)
        $(XCOPY) $(PERLIMPLIB) $(COREDIR)
 
 $(MINIMOD) : $(MINIPERL) ..\minimod.pl
-       cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm
+       cd .. 
+       miniperl minimod.pl > lib\ExtUtils\Miniperl.pm
+       cd win32
 
 ..\x2p\a2p$(o) : ..\x2p\a2p.c
        $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c
@@ -1004,10 +1025,14 @@ distclean: clean
        -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm
        -del /f $(LIBDIR)\File\Glob.pm
        -del /f $(LIBDIR)\Storable.pm
-       -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO
-       -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread
-       -if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B
-       -if exist $(LIBDIR)\Data rmdir /s /q $(LIBDIR)\Data || rmdir /s $(LIBDIR)\Data
+       -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO 
+       -rmdir /s $(LIBDIR)\IO
+       -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread 
+       -rmdir /s $(LIBDIR)\Thread
+       -if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B
+       -rmdir /s $(LIBDIR)\B
+       -if exist $(LIBDIR)\Data rmdir /s /q $(LIBDIR)\Data 
+       -rmdir /s $(LIBDIR)\Data
        -del /f $(PODDIR)\*.html
        -del /f $(PODDIR)\*.bat
        cd ..\utils
@@ -1024,8 +1049,10 @@ distclean: clean
        cd $(EXTDIR)
        -del /s *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib
        cd ..\win32
-       -if exist $(AUTODIR) rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR)
-       -if exist $(COREDIR) rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR)
+       -if exist $(AUTODIR) rmdir /s /q $(AUTODIR) 
+       -rmdir /s $(AUTODIR)
+       -if exist $(COREDIR) rmdir /s /q $(COREDIR) 
+       -rmdir /s $(COREDIR)
 
 install : all installbare installhtml
 
@@ -1082,26 +1109,26 @@ test-wide-notty : test-prep
        cd ..\win32
 
 clean : 
-       -@erase miniperlmain$(o)
-       -@erase $(MINIPERL)
-       -@erase perlglob$(o)
-       -@erase perlmain$(o)
-       -@erase config.w32
-       -@erase /f config.h
-       -@erase $(GLOBEXE)
-       -@erase $(PERLEXE)
-       -@erase $(WPERLEXE)
-       -@erase $(PERLDLL)
-       -@erase $(CORE_OBJ)
-       -if exist $(MINIDIR) rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR)
-       -@erase $(WIN32_OBJ)
-       -@erase $(DLL_OBJ)
-       -@erase $(X2P_OBJ)
-       -@erase ..\*$(o) ..\*.lib ..\*.exp *$(o) *.lib *.exp *.res
-       -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
-       -@erase ..\x2p\*.exe ..\x2p\*.bat
-       -@erase *.ilk
-       -@erase *.pdb
+       -@$(DEL) miniperlmain$(o)
+       -@$(DEL) $(MINIPERL)
+       -@$(DEL) perlglob$(o)
+       -@$(DEL) perlmain$(o)
+       -@$(DEL) config.w32
+       -@$(DEL) /f config.h
+       -@$(DEL) $(GLOBEXE)
+       -@$(DEL) $(PERLEXE)
+       -@$(DEL) $(WPERLEXE)
+       -@$(DEL) $(PERLDLL)
+       -@$(DEL) $(CORE_OBJ)
+       -if exist $(MINIDIR) deltree /y $(MINIDIR) 
+       -@$(DEL) $(WIN32_OBJ)
+       -@$(DEL) $(DLL_OBJ)
+       -@$(DEL) $(X2P_OBJ)
+       -@$(DEL) ..\*$(o) ..\*.lib ..\*.exp *$(o) *.lib *.exp *.res
+       -@$(DEL) ..\t\*.exe ..\t\*.dll ..\t\*.bat
+       -@$(DEL) ..\x2p\*.exe ..\x2p\*.bat
+       -@$(DEL) *.ilk
+       -@$(DEL) *.pdb
  
 # Handy way to run perlbug -ok without having to install and run the
 # installed perlbug. We don't re-run the tests here - we trust the user.
diff --git a/win32/bin/mdelete.bat b/win32/bin/mdelete.bat
new file mode 100644 (file)
index 0000000..0e7e8bd
--- /dev/null
@@ -0,0 +1,30 @@
+@echo off
+rem ! This is a batch file to delete all the files on its
+rem ! command line, to work around command.com's del command's
+rem ! braindeadness
+rem !
+rem !    -- BKS, 11-11-2000
+
+:nextfile
+set file=%1
+shift
+if "%file%"=="" goto end
+del %file%
+goto nextfile
+:end
+
+@echo off\r
+rem ! This is a batch file to delete all the files on its\r
+rem ! command line, to work around command.com's del command's\r
+rem ! braindeadness\r
+rem !\r
+rem !    -- BKS, 11-11-2000\r
+\r
+:nextfile\r
+set file=%1\r
+shift\r
+if "%file%"=="" goto end\r
+del %file%\r
+goto nextfile\r
+:end\r
+\r
index f6ee0c3..0bd59dd 100644 (file)
@@ -40,7 +40,7 @@ byteorder='1234'
 c=''
 castflags='0'
 cat='type'
-cc='bcc32'
+cc='~CC~'
 cccdlflags=' '
 ccdlflags='-tWD'
 ccflags='-DWIN32'
@@ -532,7 +532,7 @@ ivsize='4'
 ivtype='long'
 known_extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
 ksh=''
-ld='tlink32'
+ld='~LINK32~'
 lddlflags='-Tpd ~LINK_FLAGS~'
 ldflags='~LINK_FLAGS~'
 ldlibpthname=''
index ffb3a7f..4cdfd15 100644 (file)
@@ -40,7 +40,7 @@ byteorder='1234'
 c=''
 castflags='0'
 cat='type'
-cc='gcc'
+cc='~CC~'
 cccdlflags=' '
 ccdlflags=' '
 ccflags='-MD -DWIN32'
@@ -323,7 +323,7 @@ d_statvfs='undef'
 d_stdio_cnt_lval='define'
 d_stdio_ptr_lval='define'
 d_stdio_ptr_lval_sets_cnt='undef'
-d_stdio_ptr_lval_nochange_cnt='undef'
+d_stdio_ptr_lval_nochange_cnt='define'
 d_stdio_stream_array='undef'
 d_stdiobase='define'
 d_stdstdio='define'
index 042bcc0..d8843fd 100644 (file)
@@ -40,7 +40,7 @@ byteorder='1234'
 c=''
 castflags='0'
 cat='type'
-cc='cl'
+cc='~CC~'
 cccdlflags=' '
 ccdlflags=' '
 ccflags='-MD -DWIN32'
@@ -323,7 +323,7 @@ d_statvfs='undef'
 d_stdio_cnt_lval='define'
 d_stdio_ptr_lval='define'
 d_stdio_ptr_lval_sets_cnt='undef'
-d_stdio_ptr_lval_nochange_cnt='undef'
+d_stdio_ptr_lval_nochange_cnt='define'
 d_stdio_stream_array='undef'
 d_stdiobase='define'
 d_stdstdio='define'
@@ -532,7 +532,7 @@ ivsize='4'
 ivtype='long'
 known_extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
 ksh=''
-ld='link'
+ld='~LINK32~'
 lddlflags='-dll ~LINK_FLAGS~'
 ldflags='~LINK_FLAGS~'
 ldlibpthname=''
index 86a2bf4..d9b666a 100644 (file)
@@ -813,6 +813,7 @@ CFG_VARS    =                                       \
                INST_ARCH=$(INST_ARCH)          ~       \
                archname=$(ARCHNAME)            ~       \
                cc=$(CC)                        ~       \
+               ld=$(LINK32)                    ~       \
                ccflags=$(OPTIMIZE) $(DEFINES) $(BUILDOPT)      ~       \
                cf_email=$(EMAIL)               ~       \
                d_crypt=$(D_CRYPT)              ~       \
index 2b31878..f28efa2 100644 (file)
@@ -977,6 +977,31 @@ chown(const char *path, uid_t owner, gid_t group)
     return 0;
 }
 
+/*
+ * XXX this needs strengthening  (for PerlIO)
+ *   -- BKS, 11-11-200
+*/
+int mkstemp(const char *path)
+{
+    dTHX;
+    char buf[MAX_PATH+1];
+    int i = 0, fd = -1;
+
+retry:
+    if (i++ > 10) { /* give up */
+       errno = ENOENT;
+       return -1;
+    }
+    if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {
+       errno = ENOENT;
+       return -1;
+    }
+    fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);
+    if (fd == -1)
+       goto retry;
+    return fd;
+}
+
 static long
 find_pid(int pid)
 {
@@ -2106,7 +2131,6 @@ win32_str_os_error(void *sv, DWORD dwErr)
     }
 }
 
-
 DllExport int
 win32_fprintf(FILE *fp, const char *format, ...)
 {
@@ -2341,9 +2365,11 @@ win32_pipe(int *pfd, unsigned int size, int mode)
 
 /*
  * a popen() clone that respects PERL5SHELL
+ *
+ * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
  */
 
-DllExport FILE*
+DllExport PerlIO*
 win32_popen(const char *command, const char *mode)
 {
 #ifdef USE_RTL_POPEN
@@ -2417,7 +2443,11 @@ win32_popen(const char *command, const char *mode)
     }
 
     /* we have an fd, return a file stream */
-    return (win32_fdopen(p[parent], (char *)mode));
+#ifdef USE_PERLIO
+    return (PerlIO_fdopen(p[parent], (char *)mode));
+#else
+    return (fdopen(p[parent], (char *)mode));
+#endif
 
 cleanup:
     /* we don't need to check for errors here */
@@ -2437,7 +2467,7 @@ cleanup:
  */
 
 DllExport int
-win32_pclose(FILE *pf)
+win32_pclose(PerlIO *pf)
 {
 #ifdef USE_RTL_POPEN
     return _pclose(pf);
@@ -2447,7 +2477,7 @@ win32_pclose(FILE *pf)
     SV *sv;
 
     LOCK_FDPID_MUTEX;
-    sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
+    sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
 
     if (SvIOK(sv))
        childpid = SvIVX(sv);
@@ -2459,7 +2489,11 @@ win32_pclose(FILE *pf)
         return -1;
     }
 
-    win32_fclose(pf);
+#ifdef USE_PERLIO
+    PerlIO_close(pf);
+#else
+    fclose(pf);
+#endif
     SvIVX(sv) = 0;
     UNLOCK_FDPID_MUTEX;
 
@@ -2721,10 +2755,13 @@ win32_open(const char *path, int flag, ...)
     return open(PerlDir_mapA(path), flag, pmode);
 }
 
+/* close() that understands socket */
+extern int my_close(int);      /* in win32sck.c */
+
 DllExport int
 win32_close(int fd)
 {
-    return close(fd);
+    return my_close(fd);
 }
 
 DllExport int
index d9ffbfe..5b6062c 100644 (file)
@@ -302,6 +302,7 @@ extern  int kill(int pid, int sig);
 extern  void   *sbrk(int need);
 extern char *  getlogin(void);
 extern int     chown(const char *p, uid_t o, gid_t g);
+extern  int    mkstemp(const char *path);
 
 #undef  Stat
 #define  Stat          win32_stat
index 3b81d8b..041963a 100644 (file)
@@ -418,6 +418,41 @@ win32_socket(int af, int type, int protocol)
     return s;
 }
 
+/*
+ * close RTL fd while respecting sockets
+ * added as temporary measure until PerlIO has real
+ * Win32 native layer
+ *   -- BKS, 11-11-2000
+*/
+
+int my_close(int fd)
+{
+    int osf;
+    if (!wsock_started)                /* No WinSock? */
+       return(close(fd));      /* Then not a socket. */
+    osf = TO_SOCKET(fd);/* Get it now before it's gone! */
+    if (osf != -1) {
+       int err;
+       err = closesocket(osf);
+       if (err == 0) {
+#if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
+            _set_osfhnd(fd, INVALID_HANDLE_VALUE);
+#endif
+           (void)close(fd);    /* handle already closed, ignore error */
+           return 0;
+       }
+       else if (err == SOCKET_ERROR) {
+           err = WSAGetLastError();
+           if (err != WSAENOTSOCK) {
+               (void)close(fd);
+               errno = err;
+               return EOF;
+           }
+       }
+    }
+    return close(fd);
+}
+
 #undef fclose
 int
 my_fclose (FILE *pf)
@@ -425,14 +460,14 @@ my_fclose (FILE *pf)
     int osf;
     if (!wsock_started)                /* No WinSock? */
        return(fclose(pf));     /* Then not a socket. */
-    osf = TO_SOCKET(fileno(pf));/* Get it now before it's gone! */
+    osf = TO_SOCKET(win32_fileno(pf));/* Get it now before it's gone! */
     if (osf != -1) {
        int err;
        win32_fflush(pf);
        err = closesocket(osf);
        if (err == 0) {
 #if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
-            _set_osfhnd(fileno(pf), INVALID_HANDLE_VALUE);
+            _set_osfhnd(win32_fileno(pf), INVALID_HANDLE_VALUE);
 #endif
            (void)fclose(pf);   /* handle already closed, ignore error */
            return 0;