Change 13927 by jhi@alpha on 2001/12/29 15:27:39
Integrate perlio;
Quick fix (after couple of clever fixes failed) for
"accept leaks memory" fail [ID 20011223.001]
Nick Clark's embed.pl fix for my_socketpair
Affected files ...
.... //depot/perl/embed.h#320 integrate
.... //depot/perl/embed.pl#310 integrate
.... //depot/perl/global.sym#196 integrate
.... //depot/perl/pod/perlapi.pod#119 integrate
.... //depot/perl/pp_sys.c#274 integrate
.... //depot/perl/proto.h#362 integrate
Differences ...
==== //depot/perl/embed.h#320 (text+w) ====
Index: perl/embed.h
--- perl/embed.h.~1~ Sat Dec 29 08:45:05 2001
+++ perl/embed.h Sat Dec 29 08:45:05 2001
@@ -1230,6 +1230,30 @@
#define PerlIO_stdout Perl_PerlIO_stdout
#define PerlIO_stderr Perl_PerlIO_stderr
#endif /* PERLIO_LAYERS */
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+#define PerlIO_close Perl_PerlIO_close
+#define PerlIO_fill Perl_PerlIO_fill
+#define PerlIO_fileno Perl_PerlIO_fileno
+#define PerlIO_eof Perl_PerlIO_eof
+#define PerlIO_error Perl_PerlIO_error
+#define PerlIO_flush Perl_PerlIO_flush
+#define PerlIO_clearerr Perl_PerlIO_clearerr
+#define PerlIO_set_cnt Perl_PerlIO_set_cnt
+#define PerlIO_set_ptrcnt Perl_PerlIO_set_ptrcnt
+#define PerlIO_setlinebuf Perl_PerlIO_setlinebuf
+#define PerlIO_read Perl_PerlIO_read
+#define PerlIO_write Perl_PerlIO_write
+#define PerlIO_unread Perl_PerlIO_unread
+#define PerlIO_tell Perl_PerlIO_tell
+#define PerlIO_seek Perl_PerlIO_seek
+#define PerlIO_get_base Perl_PerlIO_get_base
+#define PerlIO_get_ptr Perl_PerlIO_get_ptr
+#define PerlIO_get_bufsiz Perl_PerlIO_get_bufsiz
+#define PerlIO_get_cnt Perl_PerlIO_get_cnt
+#define PerlIO_stdin Perl_PerlIO_stdin
+#define PerlIO_stdout Perl_PerlIO_stdout
+#define PerlIO_stderr Perl_PerlIO_stderr
+#endif /* PERLIO_LAYERS */
#define ck_anoncode Perl_ck_anoncode
#define ck_bitop Perl_ck_bitop
#define ck_concat Perl_ck_concat
@@ -2745,7 +2769,7 @@
#define sv_2pv_flags(a,b,c) Perl_sv_2pv_flags(aTHX_ a,b,c)
#define my_atof2(a,b) Perl_my_atof2(aTHX_ a,b)
#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET)
-#define my_socketpair(a,b,c,d) Perl_my_socketpair(aTHX_ a,b,c,d)
+#define my_socketpair Perl_my_socketpair
#endif
#if defined(USE_PERLIO) && !defined(USE_SFIO)
#define PerlIO_close(a) Perl_PerlIO_close(aTHX_ a)
@@ -2771,6 +2795,30 @@
#define PerlIO_stdout() Perl_PerlIO_stdout(aTHX)
#define PerlIO_stderr() Perl_PerlIO_stderr(aTHX)
#endif /* PERLIO_LAYERS */
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+#define PerlIO_close(a) Perl_PerlIO_close(aTHX_ a)
+#define PerlIO_fill(a) Perl_PerlIO_fill(aTHX_ a)
+#define PerlIO_fileno(a) Perl_PerlIO_fileno(aTHX_ a)
+#define PerlIO_eof(a) Perl_PerlIO_eof(aTHX_ a)
+#define PerlIO_error(a) Perl_PerlIO_error(aTHX_ a)
+#define PerlIO_flush(a) Perl_PerlIO_flush(aTHX_ a)
+#define PerlIO_clearerr(a) Perl_PerlIO_clearerr(aTHX_ a)
+#define PerlIO_set_cnt(a,b) Perl_PerlIO_set_cnt(aTHX_ a,b)
+#define PerlIO_set_ptrcnt(a,b,c) Perl_PerlIO_set_ptrcnt(aTHX_ a,b,c)
+#define PerlIO_setlinebuf(a) Perl_PerlIO_setlinebuf(aTHX_ a)
+#define PerlIO_read(a,b,c) Perl_PerlIO_read(aTHX_ a,b,c)
+#define PerlIO_write(a,b,c) Perl_PerlIO_write(aTHX_ a,b,c)
+#define PerlIO_unread(a,b,c) Perl_PerlIO_unread(aTHX_ a,b,c)
+#define PerlIO_tell(a) Perl_PerlIO_tell(aTHX_ a)
+#define PerlIO_seek(a,b,c) Perl_PerlIO_seek(aTHX_ a,b,c)
+#define PerlIO_get_base(a) Perl_PerlIO_get_base(aTHX_ a)
+#define PerlIO_get_ptr(a) Perl_PerlIO_get_ptr(aTHX_ a)
+#define PerlIO_get_bufsiz(a) Perl_PerlIO_get_bufsiz(aTHX_ a)
+#define PerlIO_get_cnt(a) Perl_PerlIO_get_cnt(aTHX_ a)
+#define PerlIO_stdin() Perl_PerlIO_stdin(aTHX)
+#define PerlIO_stdout() Perl_PerlIO_stdout(aTHX)
+#define PerlIO_stderr() Perl_PerlIO_stderr(aTHX)
+#endif /* PERLIO_LAYERS */
#define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a) Perl_ck_bitop(aTHX_ a)
#define ck_concat(a) Perl_ck_concat(aTHX_ a)
==== //depot/perl/embed.pl#310 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl.~1~ Sat Dec 29 08:45:05 2001
+++ perl/embed.pl Sat Dec 29 08:45:05 2001
@@ -2354,7 +2354,7 @@
Apd |char* |sv_2pv_flags |SV* sv|STRLEN* lp|I32 flags
Ap |char* |my_atof2 |const char *s|NV* value
#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET)
-Ap |int |my_socketpair |int family|int type|int protocol|int fd[2]
+Apn |int |my_socketpair |int family|int type|int protocol|int fd[2]
#endif
==== //depot/perl/global.sym#196 (text+w) ====
Index: perl/global.sym
--- perl/global.sym.~1~ Sat Dec 29 08:45:05 2001
+++ perl/global.sym Sat Dec 29 08:45:05 2001
@@ -627,3 +627,25 @@
Perl_PerlIO_stdin
Perl_PerlIO_stdout
Perl_PerlIO_stderr
+Perl_PerlIO_close
+Perl_PerlIO_fill
+Perl_PerlIO_fileno
+Perl_PerlIO_eof
+Perl_PerlIO_error
+Perl_PerlIO_flush
+Perl_PerlIO_clearerr
+Perl_PerlIO_set_cnt
+Perl_PerlIO_set_ptrcnt
+Perl_PerlIO_setlinebuf
+Perl_PerlIO_read
+Perl_PerlIO_write
+Perl_PerlIO_unread
+Perl_PerlIO_tell
+Perl_PerlIO_seek
+Perl_PerlIO_get_base
+Perl_PerlIO_get_ptr
+Perl_PerlIO_get_bufsiz
+Perl_PerlIO_get_cnt
+Perl_PerlIO_stdin
+Perl_PerlIO_stdout
+Perl_PerlIO_stderr
==== //depot/perl/pod/perlapi.pod#119 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod.~1~ Sat Dec 29 08:45:05 2001
+++ perl/pod/perlapi.pod Sat Dec 29 08:45:05 2001
@@ -1440,6 +1440,17 @@
=for hackers
Found in file sv.c
+=item newSV
+
+Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
+with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
+macro.
+
+ SV* newSV(STRLEN len)
+
+=for hackers
+Found in file sv.c
+
=item NEWSV
Creates a new SV. A non-zero C<len> parameter indicates the number of
@@ -1453,17 +1464,6 @@
=for hackers
Found in file handy.h
-=item newSV
-
-Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
-with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
-macro.
-
- SV* newSV(STRLEN len)
-
-=for hackers
-Found in file sv.c
-
=item newSViv
Creates a new SV and copies an integer into it. The reference count for the
@@ -3016,22 +3016,22 @@
=for hackers
Found in file sv.h
-=item SvUVx
+=item SvUVX
-Coerces the given SV to an unsigned integer and returns it. Guarantees to
-evaluate sv only once. Use the more efficient C<SvUV> otherwise.
+Returns the raw value in the SV's UV slot, without checks or conversions.
+Only use when you are sure SvIOK is true. See also C<SvUV()>.
- UV SvUVx(SV* sv)
+ UV SvUVX(SV* sv)
=for hackers
Found in file sv.h
-=item SvUVX
+=item SvUVx
-Returns the raw value in the SV's UV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvUV()>.
+Coerces the given SV to an unsigned integer and returns it. Guarantees to
+evaluate sv only once. Use the more efficient C<SvUV> otherwise.
- UV SvUVX(SV* sv)
+ UV SvUVx(SV* sv)
=for hackers
Found in file sv.h
==== //depot/perl/pp_sys.c#274 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c.~1~ Sat Dec 29 08:45:05 2001
+++ perl/pp_sys.c Sat Dec 29 08:45:05 2001
@@ -2066,7 +2066,7 @@
else {
SV *sv = POPs;
char *name;
-
+
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv; /* *main::FRED for example */
goto do_ftruncate;
@@ -2469,6 +2469,7 @@
struct sockaddr saddr; /* use a struct to avoid alignment problems */
Sock_size_t len = sizeof saddr;
int fd;
+ int fd2;
ggv = (GV*)POPs;
ngv = (GV*)POPs;
@@ -2489,7 +2490,11 @@
if (IoIFP(nstio))
do_close(ngv, FALSE);
IoIFP(nstio) = PerlIO_fdopen(fd, "r");
- IoOFP(nstio) = PerlIO_fdopen(fd, "w");
+ /* FIXME: we dup(fd) here so that refcounting of fd's does not inhibit
+ fclose of IoOFP's FILE * - and hence leak memory.
+ Special treatment of _this_ case of IoIFP != IoOFP seems wrong.
+ */
+ IoOFP(nstio) = PerlIO_fdopen(fd2 = PerlLIO_dup(fd), "w");
IoTYPE(nstio) = IoTYPE_SOCKET;
if (!IoIFP(nstio) || !IoOFP(nstio)) {
if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
@@ -2499,6 +2504,7 @@
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */
+ fcntl(fd2, F_SETFD, fd2 > PL_maxsysfd); /* ensure close-on-exec */
#endif
#ifdef EPOC
@@ -3410,7 +3416,7 @@
deprecate("chdir('') or chdir(undef) as chdir()");
tmps = SvPV(*svp, n_a);
}
- else {
+ else {
PUSHi(0);
TAINT_PROPER("chdir");
RETURN;
@@ -4029,7 +4035,7 @@
Pid_t childpid;
int status;
Sigsave_t ihand,qhand; /* place to save signals during system() */
-
+
if (PL_tainting) {
SV *cmd = NULL;
if (PL_op->op_flags & OPf_STACKED)
@@ -4075,7 +4081,7 @@
if (did_pipes) {
int errkid;
int n = 0, n1;
-
+
while (n < sizeof(int)) {
n1 = PerlLIO_read(pp[0],
(void*)(((char*)&errkid)+n),
==== //depot/perl/proto.h#362 (text+w) ====
Index: perl/proto.h
--- perl/proto.h.~1~ Sat Dec 29 08:45:05 2001
+++ perl/proto.h Sat Dec 29 08:45:05 2001
@@ -1332,7 +1332,7 @@
PERL_CALLCONV char* Perl_sv_2pv_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags);
PERL_CALLCONV char* Perl_my_atof2(pTHX_ const char *s, NV* value);
#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET)
-PERL_CALLCONV int Perl_my_socketpair(pTHX_ int family, int type, int protocol,
int fd[2]);
+PERL_CALLCONV int Perl_my_socketpair(int family, int type, int protocol, int
+fd[2]);
#endif
End of Patch.
