Change 14218 by jhi@alpha on 2002/01/12 16:14:52
Integrate perlio;
Abstract out the cloning of SvPVX and handle shared pv in a
safe (if suboptimal) manner. Does not fix op/fork.t :-(
Win32-ize socketpair test
- Win32 can fork even though $Config{d_fork} is undef
- SOCK_DGRAM does not work - skip those tests.
Affected files ...
.... //depot/perl/ext/Socket/socketpair.t#9 integrate
.... //depot/perl/sv.c#507 integrate
Differences ...
==== //depot/perl/ext/Socket/socketpair.t#9 (text) ====
Index: perl/ext/Socket/socketpair.t
--- perl/ext/Socket/socketpair.t.~1~ Sat Jan 12 09:30:06 2002
+++ perl/ext/Socket/socketpair.t Sat Jan 12 09:30:06 2002
@@ -1,11 +1,14 @@
#!./perl -w
my $child;
+my $can_fork;
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ $can_fork = $Config{d_fork} || ($^O eq 'MSWin32' && $Config{useithreads});
+
if ($Config{'extensions'} !~ /\bSocket\b/ &&
!(($^O eq 'VMS') && $Config{d_socket})) {
print "1..0\n";
@@ -18,7 +21,7 @@
# This is convoluted, but we must fork before Test::More, else child's
# Test::More thinks that it ran no tests, and prints a message to that
# effect
- if( $Config{d_fork} ) {
+ if( $can_fork) {
my $parent = $$;
$child = fork;
die "Fork failed" unless defined $child;
@@ -46,7 +49,7 @@
if( !$Config{d_alarm} ) {
plan skip_all => "alarm() not implemented on this platform";
-} elsif( !$Config{d_fork} ) {
+} elsif( !$can_fork ) {
plan skip_all => "fork() not implemented on this platform";
} else {
# This should fail but not die if there is real socketpair
@@ -115,7 +118,7 @@
is (syswrite (LEFT, "void"), undef, "syswrite to shutdown left should fail");
alarm 60;
}
-SKIP: {
+{
# This may need skipping on some OSes
ok (($!{EPIPE} or $!{ESHUTDOWN}), '$! should be EPIPE or ESHUTDOWN')
or printf "\$\!=%d(%s)\n", $!, $!;
@@ -136,10 +139,15 @@
ok (close LEFT, "close left");
ok (close RIGHT, "close right");
+
# And now datagrams
# I suspect we also need a self destruct time-bomb for these, as I don't see any
# guarantee that the stack won't drop a UDP packet, even if it is for localhost.
+SKIP: {
+ skip "No usable SOCK_DGRAM", 24 if ($^O eq 'MSWin32');
+
+
ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC),
"socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)")
or print "# \$\! = $!\n";
@@ -200,5 +208,7 @@
ok (close LEFT, "close left");
ok (close RIGHT, "close right");
+} # end of DGRAM SKIP
+
kill "INT", $child or warn "Failed to kill child process $child: $!";
exit 0;
==== //depot/perl/sv.c#507 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Sat Jan 12 09:30:06 2002
+++ perl/sv.c Sat Jan 12 09:30:06 2002
@@ -8881,6 +8881,40 @@
/* duplicate an SV of any type (including AV, HV etc) */
+void
+Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
+{
+ if (SvROK(sstr)) {
+ SvRV(dstr) = SvWEAKREF(sstr)
+ ? sv_dup(SvRV(sstr), param)
+ : sv_dup_inc(SvRV(sstr), param);
+ }
+ else if (SvPVX(sstr)) {
+ /* Has something there */
+ if (SvLEN(sstr)) {
+ /* Normal PV - clone whole allocated space */
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ }
+ else {
+ /* Special case - not normally malloced for some reason */
+ if (SvREADONLY(sstr) && SvFAKE(sstr)) {
+ /* A "shared" PV - clone it as unshared string */
+ SvFAKE_off(dstr);
+ SvREADONLY_off(dstr);
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ }
+ else {
+ /* Some other special case - random pointer */
+ SvPVX(dstr) = SvPVX(sstr);
+ }
+ }
+ }
+ else {
+ /* Copy the Null */
+ SvPVX(dstr) = SvPVX(sstr);
+ }
+}
+
SV *
Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
{
@@ -8922,36 +8956,20 @@
break;
case SVt_RV:
SvANY(dstr) = new_XRV();
- SvRV(dstr) = SvRV(sstr) && SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PV:
SvANY(dstr) = new_XPV();
SvCUR(dstr) = SvCUR(sstr);
SvLEN(dstr) = SvLEN(sstr);
- if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
- else if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PVIV:
SvANY(dstr) = new_XPVIV();
SvCUR(dstr) = SvCUR(sstr);
SvLEN(dstr) = SvLEN(sstr);
SvIVX(dstr) = SvIVX(sstr);
- if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
- else if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PVNV:
SvANY(dstr) = new_XPVNV();
@@ -8959,14 +8977,7 @@
SvLEN(dstr) = SvLEN(sstr);
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
- if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
- else if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PVMG:
SvANY(dstr) = new_XPVMG();
@@ -8976,14 +8987,7 @@
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
- if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
- else if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PVBM:
SvANY(dstr) = new_XPVBM();
@@ -8993,14 +8997,7 @@
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
- if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
- else if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
BmRARE(dstr) = BmRARE(sstr);
BmUSEFUL(dstr) = BmUSEFUL(sstr);
BmPREVIOUS(dstr)= BmPREVIOUS(sstr);
@@ -9013,14 +9010,7 @@
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
- if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
- else if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
LvTARGOFF(dstr) = LvTARGOFF(sstr); /* XXX sometimes holds PMOP* when
DEBUGGING */
LvTARGLEN(dstr) = LvTARGLEN(sstr);
LvTARG(dstr) = sv_dup_inc(LvTARG(sstr), param);
@@ -9046,14 +9036,7 @@
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
- if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
- else if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
GvNAMELEN(dstr) = GvNAMELEN(sstr);
GvNAME(dstr) = SAVEPVN(GvNAME(sstr), GvNAMELEN(sstr));
GvSTASH(dstr) = hv_dup_inc(GvSTASH(sstr), param);
@@ -9069,14 +9052,7 @@
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
- if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
- else if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr), param);
if (IoOFP(sstr) == IoIFP(sstr))
IoOFP(dstr) = IoIFP(dstr);
@@ -9184,10 +9160,7 @@
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
- if (SvPVX(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
- else
- SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ Perl_rvpv_dup(aTHX_ dstr, sstr, param);
CvSTASH(dstr) = hv_dup(CvSTASH(sstr), param); /* NOTE: not refcounted */
CvSTART(dstr) = CvSTART(sstr);
CvROOT(dstr) = OpREFCNT_inc(CvROOT(sstr));
End of Patch.
