This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate changes#7858,7986 from mainline
authorGurusamy Sarathy <gsar@cpan.org>
Mon, 18 Dec 2000 01:55:22 +0000 (01:55 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Mon, 18 Dec 2000 01:55:22 +0000 (01:55 +0000)
    C<foreach my $x ...> in pseudo-fork()ed process may diddle
    parent's memory; fix it by keeping track of the actual pad
    offset rather than a raw pointer (this change is probably also
    relevant to non-ithreads case to avoid fallout from reallocs of
    the pad array, but is currently only enabled for the ithreads
    case in the interests of minimal disruption to existing "well
    tested" code)

    fix open(FOO, ">&MYSOCK") failure under Windows 9x (problem is
    due to the notorious GetFileType() bug in Windows 9x, which fstat()
    tickles)

p4raw-link: @7986 on //depot/perl: ed59ec62717f0f88ed3d32dff6bf15dd59269b91
p4raw-link: @7858 on //depot/perl: c3564e5c35b594706ecb001261b86a47fb837059

p4raw-id: //depot/maint-5.6/perl@8167
p4raw-integrated: from //depot/perl@8166 'ignore' win32/perlhost.h
(@7985..) 'merge in' win32/win32sck.c (@7756..) scope.h
(@7792..) win32/win32.h (@7972..) win32/win32.c (@7984..)
p4raw-integrated: from //depot/perl@7858 'copy in' t/op/fork.t
(@6874..) 'merge in' scope.c (@7435..) objXSUB.h perlapi.c
(@7744..) global.sym (@7756..) pp_ctl.c (@7784..) sv.c
(@7824..) embed.h embed.pl proto.h (@7855..)

14 files changed:
embed.h
embed.pl
global.sym
objXSUB.h
perlapi.c
pp_ctl.c
proto.h
scope.c
scope.h
sv.c
t/op/fork.t
win32/win32.c
win32/win32.h
win32/win32sck.c

diff --git a/embed.h b/embed.h
index 1837b3f..c3ba008 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define save_pptr              Perl_save_pptr
 #define save_vptr              Perl_save_vptr
 #define save_re_context                Perl_save_re_context
+#define save_padsv             Perl_save_padsv
 #define save_sptr              Perl_save_sptr
 #define save_svref             Perl_save_svref
 #define save_threadsv          Perl_save_threadsv
 #define save_pptr(a)           Perl_save_pptr(aTHX_ a)
 #define save_vptr(a)           Perl_save_vptr(aTHX_ a)
 #define save_re_context()      Perl_save_re_context(aTHX)
+#define save_padsv(a)          Perl_save_padsv(aTHX_ a)
 #define save_sptr(a)           Perl_save_sptr(aTHX_ a)
 #define save_svref(a)          Perl_save_svref(aTHX_ a)
 #define save_threadsv(a)       Perl_save_threadsv(aTHX_ a)
 #define save_vptr              Perl_save_vptr
 #define Perl_save_re_context   CPerlObj::Perl_save_re_context
 #define save_re_context                Perl_save_re_context
+#define Perl_save_padsv                CPerlObj::Perl_save_padsv
+#define save_padsv             Perl_save_padsv
 #define Perl_save_sptr         CPerlObj::Perl_save_sptr
 #define save_sptr              Perl_save_sptr
 #define Perl_save_svref                CPerlObj::Perl_save_svref
index 7af1b17..9e6ee89 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1932,6 +1932,7 @@ Ap        |SV*    |save_scalar    |GV* gv
 Ap     |void   |save_pptr      |char** pptr
 Ap     |void   |save_vptr      |void* pptr
 Ap     |void   |save_re_context
+Ap     |void   |save_padsv     |PADOFFSET off
 Ap     |void   |save_sptr      |SV** sptr
 Ap     |SV*    |save_svref     |SV** sptr
 Ap     |SV**   |save_threadsv  |PADOFFSET i
index e581f36..9df6a8d 100644 (file)
@@ -357,6 +357,7 @@ Perl_save_scalar
 Perl_save_pptr
 Perl_save_vptr
 Perl_save_re_context
+Perl_save_padsv
 Perl_save_sptr
 Perl_save_svref
 Perl_save_threadsv
index 49c93b8..09c5236 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
 #define Perl_save_re_context   pPerl->Perl_save_re_context
 #undef  save_re_context
 #define save_re_context                Perl_save_re_context
+#undef  Perl_save_padsv
+#define Perl_save_padsv                pPerl->Perl_save_padsv
+#undef  save_padsv
+#define save_padsv             Perl_save_padsv
 #undef  Perl_save_sptr
 #define Perl_save_sptr         pPerl->Perl_save_sptr
 #undef  save_sptr
index b4f5057..1396a88 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -2608,6 +2608,13 @@ Perl_save_re_context(pTHXo)
     ((CPerlObj*)pPerl)->Perl_save_re_context();
 }
 
+#undef  Perl_save_padsv
+void
+Perl_save_padsv(pTHXo_ PADOFFSET off)
+{
+    ((CPerlObj*)pPerl)->Perl_save_padsv(off);
+}
+
 #undef  Perl_save_sptr
 void
 Perl_save_sptr(pTHXo_ SV** sptr)
index 23b8b79..c0e7bed 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1723,9 +1723,11 @@ PP(pp_enteriter)
     else
 #endif /* USE_THREADS */
     if (PL_op->op_targ) {
+#ifndef USE_ITHREADS
        svp = &PL_curpad[PL_op->op_targ];               /* "my" variable */
        SAVESPTR(*svp);
-#ifdef USE_ITHREADS
+#else
+       SAVEPADSV(PL_op->op_targ);
        iterdata = (void*)PL_op->op_targ;
        cxtype |= CXp_PADVAR;
 #endif
diff --git a/proto.h b/proto.h
index da71f1e..6bb94a6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -668,6 +668,7 @@ PERL_CALLCONV SV*   Perl_save_scalar(pTHX_ GV* gv);
 PERL_CALLCONV void     Perl_save_pptr(pTHX_ char** pptr);
 PERL_CALLCONV void     Perl_save_vptr(pTHX_ void* pptr);
 PERL_CALLCONV void     Perl_save_re_context(pTHX);
+PERL_CALLCONV void     Perl_save_padsv(pTHX_ PADOFFSET off);
 PERL_CALLCONV void     Perl_save_sptr(pTHX_ SV** sptr);
 PERL_CALLCONV SV*      Perl_save_svref(pTHX_ SV** sptr);
 PERL_CALLCONV SV**     Perl_save_threadsv(pTHX_ PADOFFSET i);
diff --git a/scope.c b/scope.c
index 0544b89..0b348df 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -469,6 +469,17 @@ Perl_save_sptr(pTHX_ SV **sptr)
     SSPUSHINT(SAVEt_SPTR);
 }
 
+void
+Perl_save_padsv(pTHX_ PADOFFSET off)
+{
+    dTHR;
+    SSCHECK(4);
+    SSPUSHPTR(PL_curpad[off]);
+    SSPUSHPTR(PL_curpad);
+    SSPUSHLONG((long)off);
+    SSPUSHINT(SAVEt_PADSV);
+}
+
 SV **
 Perl_save_threadsv(pTHX_ PADOFFSET i)
 {
@@ -960,6 +971,14 @@ Perl_leave_scope(pTHX_ I32 base)
            else
                PL_curpad = Null(SV**);
            break;
+       case SAVEt_PADSV:
+           {
+               PADOFFSET off = (PADOFFSET)SSPOPLONG;
+               ptr = SSPOPPTR;
+               if (ptr)
+                   ((SV**)ptr)[off] = (SV*)SSPOPPTR;
+           }
+           break;
        default:
            Perl_croak(aTHX_ "panic: leave_scope inconsistency");
        }
diff --git a/scope.h b/scope.h
index e6a4209..97b36a3 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -33,6 +33,7 @@
 #define SAVEt_I8               32
 #define SAVEt_COMPPAD          33
 #define SAVEt_GENERIC_PVREF    34
+#define SAVEt_PADSV            35
 
 #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow()
 #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
@@ -101,6 +102,7 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVESPTR(s)    save_sptr((SV**)&(s))
 #define SAVEPPTR(s)    save_pptr(SOFT_CAST(char**)&(s))
 #define SAVEVPTR(s)    save_vptr((void*)&(s))
+#define SAVEPADSV(s)   save_padsv(s)
 #define SAVEFREESV(s)  save_freesv((SV*)(s))
 #define SAVEFREEOP(o)  save_freeop(SOFT_CAST(OP*)(o))
 #define SAVEFREEPV(p)  save_freepv(SOFT_CAST(char*)(p))
diff --git a/sv.c b/sv.c
index f07a883..6f520c0 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -7559,6 +7559,14 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
            av = (AV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = av_dup(av);
            break;
+       case SAVEt_PADSV:
+           longval = (long)POPLONG(ss,ix);
+           TOPLONG(nss,ix) = longval;
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+           sv = (SV*)POPPTR(ss,ix);
+           TOPPTR(nss,ix) = sv_dup(sv);
+           break;
        default:
            Perl_croak(aTHX_ "panic: ss_dup inconsistency");
        }
index 93cf673..88b6b4b 100755 (executable)
@@ -184,6 +184,28 @@ child 3
 [1] -2- -3-
 -1- -2- -3-
 ########
+$| = 1;
+foreach my $c (1,2,3) {
+    if (fork) {
+       print "parent $c\n";
+    }
+    else {
+       print "child $c\n";
+       exit;
+    }
+}
+while (wait() != -1) { print "waited\n" }
+EXPECT
+child 1
+child 2
+child 3
+parent 1
+parent 2
+parent 3
+waited
+waited
+waited
+########
 use Config;
 $| = 1;
 $\ = "\n";
index 2b31878..016e56a 100644 (file)
@@ -2329,7 +2329,7 @@ win32_fstat(int fd,struct stat *sbufptr)
     }
     return rc;
 #else
-    return fstat(fd,sbufptr);
+    return my_fstat(fd,sbufptr);
 #endif
 }
 
index d9ffbfe..937b013 100644 (file)
@@ -343,6 +343,7 @@ DllExport void              win32_get_child_IO(child_IO_table* ptr);
 extern FILE *          my_fdopen(int, char *);
 #endif
 extern int             my_fclose(FILE *);
+extern int             my_fstat(int fd, struct stat *sbufptr);
 extern int             do_aspawn(void *really, void **mark, void **sp);
 extern int             do_spawn(char *cmd);
 extern int             do_spawn_nowait(char *cmd);
index 3b81d8b..4ed805e 100644 (file)
@@ -449,6 +449,41 @@ my_fclose (FILE *pf)
     return fclose(pf);
 }
 
+#undef fstat
+int
+my_fstat(int fd, struct stat *sbufptr)
+{
+    /* This fixes a bug in fstat() on Windows 9x.  fstat() uses the
+     * GetFileType() win32 syscall, which will fail on Windows 9x.
+     * So if we recognize a socket on Windows 9x, we return the
+     * same results as on Windows NT/2000.
+     * XXX this should be extended further to set S_IFSOCK on
+     * sbufptr->st_mode.
+     */
+    int osf;
+    if (!wsock_started || IsWinNT())
+       return fstat(fd, sbufptr);
+
+    osf = TO_SOCKET(fd);
+    if (osf != -1) {
+       char sockbuf[256];
+       int optlen = sizeof(sockbuf);
+       int retval;
+
+       retval = getsockopt((SOCKET)osf, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
+       if (retval != SOCKET_ERROR || WSAGetLastError() != WSAENOTSOCK) {
+           sbufptr->st_mode = _S_IFIFO;
+           sbufptr->st_rdev = sbufptr->st_dev = (dev_t)fd;
+           sbufptr->st_nlink = 1;
+           sbufptr->st_uid = sbufptr->st_gid = sbufptr->st_ino = 0;
+           sbufptr->st_atime = sbufptr->st_mtime = sbufptr->st_ctime = 0;
+           sbufptr->st_size = (off_t)0;
+           return 0;
+       }
+    }
+    return fstat(fd, sbufptr);
+}
+
 struct hostent *
 win32_gethostbyaddr(const char *addr, int len, int type)
 {