From 50a10aa9ee8078187ccbf23315da715a7a47532f Mon Sep 17 00:00:00 2001 From: Graham Barr Date: Sun, 29 Nov 1998 22:11:16 +0000 Subject: [PATCH] integrate changes#2254,2259,2335,2345,2348,2361,2368,2380 from mainline win32_recvfrom() compatibility fix From: "Kurt D. Starsinic" Subject: Re: [PATCH] Re: pod2man bug in date generated line To: Albert Dvornik , "Larry W. Virden" Cc: perlbug@perl.com Date: 20 Nov 1998 21:30:17 +0200 Message-ID: make $1 et al readonly under threads; make C fail like C<$1 = undef> does fix typo in pp_defined() causing C to fail more conservative version of changes#2345,2346,2347; those break C which seems to be extensively used in the libs :-( fix uninitialized warnings From: Brian Callaghan Date: Thu, 19 Nov 1998 17:49:10 -0800 Message-Id: <3654CA96.B64FCAEB@itginc.com> Subject: Complete.pm patch (version 1.1) Liblist tweak suggested by Swen Thuemmler ; add C<$Config{installarchlib}/CORE> to the default locations searched on win32 prefer IO::Handle for IO if FileHandle:: is empty (as suggested by Tim Bunce) p4raw-link: @2348 on //depot/perl: 6051dbdb749e970695dd861ca273edafbbb539cb p4raw-link: @2347 on //depot/perl: bbc8e6a4a34cbf904dc23fa18f4e503924aea3f8 p4raw-link: @2346 on //depot/perl: 659eaf7385567ca82dd230a62d6a7f51364f0d0a p4raw-link: @2345 on //depot/perl: 6b377df57679ab68ed17b736ebee0458acb25b21 p4raw-link: @2335 on //depot/perl: a3f914c54a06647534c0855205d45eb950aebdd4 p4raw-link: @2259 on //depot/cfgperl: 10d20342241794db0c535c2739c380f367a9f178 p4raw-link: @2254 on //depot/perl: e4449fe1872a24e805fcc129361ea26a406317d8 p4raw-id: //depot/maint-5.005/perl@2398 p4raw-integrated: from //depot/perl@2335 'copy in' t/op/undef.t (@1575..) p4raw-integrated: from //depot/perl@2315 'copy in' win32/win32sck.c (@1612..) lib/ExtUtils/Liblist.pm pod/perlfaq4.pod (@1760..) pod/pod2man.PL (@1922..) lib/Term/Complete.pm (@2003..) --- gv.c | 3 ++- lib/ExtUtils/Liblist.pm | 12 ++++++++---- lib/Term/Complete.pm | 11 ++++++----- op.c | 10 ++++++++++ pod/perlfaq4.pod | 2 +- pod/pod2man.PL | 1 + pp.c | 11 +++++++---- t/op/undef.t | 11 ++++++++--- win32/win32sck.c | 7 +++++++ 9 files changed, 50 insertions(+), 18 deletions(-) diff --git a/gv.c b/gv.c index c5ee79a..a4b0b43 100644 --- a/gv.c +++ b/gv.c @@ -851,7 +851,8 @@ newIO(void) SvREFCNT(io) = 1; SvOBJECT_on(io); iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV); - if (!iogv) + /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */ + if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv)))) iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV); SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv)); return io; diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index b072c12..1710c5e 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -225,6 +225,9 @@ sub _win32_ext { my $search = 1; my($fullname, $thislib, $thispth); + # add "$Config{installarchlib}/CORE" to default search path + push @libpath, "$Config{installarchlib}/CORE"; + foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){ $thislib = $_; @@ -240,8 +243,8 @@ sub _win32_ext { # if searching is disabled, do compiler-specific translations unless ($search) { - s/^-L/-libpath:/ if $VC; s/^-l(.+)$/$1.lib/ unless $GC; + s/^-L/-libpath:/ if $VC; push(@extralibs, $_); $found++; next; @@ -625,9 +628,10 @@ Unix-OS/2 version in several respects: If C<$potential_libs> is empty, the return value will be empty. Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) will be appended to the list of C<$potential_libs>. The libraries -will be searched for in the directories specified in C<$potential_libs> -as well as in C<$Config{libpth}>. For each library that is found, a -space-separated list of fully qualified library pathnames is generated. +will be searched for in the directories specified in C<$potential_libs>, +C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. +For each library that is found, a space-separated list of fully qualified +library pathnames is generated. =item * diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm index f26be77..9f1256a 100644 --- a/lib/Term/Complete.pm +++ b/lib/Term/Complete.pm @@ -5,7 +5,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(Complete); -# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91 +# @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91 =head1 NAME @@ -72,7 +72,8 @@ CONFIG: { } sub Complete { - my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r); + my($prompt, @cmp_list, $cmp, $test, $l, @match); + my ($return, $r) = ("", 0); $return = ""; $r = 0; @@ -93,17 +94,17 @@ sub Complete { # (TAB) attempt completion $_ eq "\t" && do { @match = grep(/^$return/, @cmp_lst); - $l = length($test = shift(@match)); unless ($#match < 0) { + $l = length($test = shift(@match)); foreach $cmp (@match) { until (substr($cmp, 0, $l) eq substr($test, 0, $l)) { $l--; } } print("\a"); + print($test = substr($test, $r, $l - $r)); + $r = length($return .= $test); } - print($test = substr($test, $r, $l - $r)); - $r = length($return .= $test); last CASE; }; diff --git a/op.c b/op.c index c991051..273b418 100644 --- a/op.c +++ b/op.c @@ -564,6 +564,16 @@ find_threadsv(char *name) case '`': case '\'': PL_sawampersand = TRUE; + /* FALL THROUGH */ + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': SvREADONLY_on(sv); /* FALL THROUGH */ diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index aa6b6a5..39325c2 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -1326,7 +1326,7 @@ The Data::Dumper module on CPAN is nice for printing out data structures, and FreezeThaw for copying them. For example: use FreezeThaw qw(freeze thaw); - $new = thaw freeze $old; + ($new) = thaw freeze $old; Where $old can be (a reference to) any kind of data structure you'd like. It will be deeply copied. diff --git a/pod/pod2man.PL b/pod/pod2man.PL index 9d0ecc3..4edf4f8 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -331,6 +331,7 @@ sub makedate { my $secs = shift; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs); my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon]; + $year += 1900; return "$mday/$mname/$year"; } diff --git a/pp.c b/pp.c index ef9d138..4a498ac 100644 --- a/pp.c +++ b/pp.c @@ -716,11 +716,11 @@ PP(pp_defined) RETPUSHNO; switch (SvTYPE(sv)) { case SVt_PVAV: - if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)) + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) RETPUSHYES; break; case SVt_PVHV: - if (HvARRAY(sv) || SvGMAGICAL(sv)) + if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) RETPUSHYES; break; case SVt_PVCV: @@ -751,8 +751,11 @@ PP(pp_undef) RETPUSHUNDEF; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) - RETPUSHUNDEF; + if (SvREADONLY(sv)) { + dTHR; + if (PL_curcop != &PL_compiling) + croak(no_modify); + } if (SvROK(sv)) sv_unref(sv); } diff --git a/t/op/undef.t b/t/op/undef.t index 8ab2ec4..5b3c7ef 100755 --- a/t/op/undef.t +++ b/t/op/undef.t @@ -1,8 +1,6 @@ #!./perl -# $RCSfile: undef.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:34 $ - -print "1..21\n"; +print "1..23\n"; print defined($a) ? "not ok 1\n" : "ok 1\n"; @@ -54,3 +52,10 @@ sub foo { print "ok 19\n"; } print defined &foo ? "ok 20\n" : "not ok 20\n"; undef &foo; print defined(&foo) ? "not ok 21\n" : "ok 21\n"; + +eval { undef $1 }; +print $@ =~ /^Modification of a read/ ? "ok 22\n" : "not ok 22\n"; + +eval { $1 = undef }; +print $@ =~ /^Modification of a read/ ? "ok 23\n" : "not ok 23\n"; + diff --git a/win32/win32sck.c b/win32/win32sck.c index 52dc128..2713605 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -287,8 +287,15 @@ int win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int *fromlen) { int r; + int frombufsize = *fromlen; SOCKET_TEST_ERROR(r = recvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen)); + /* Winsock's recvfrom() only returns a valid 'from' when the socket + * is connectionless. Perl expects a valid 'from' for all types + * of sockets, so go the extra mile. + */ + if (r != SOCKET_ERROR && frombufsize == *fromlen) + (void)win32_getpeername(s, from, fromlen); return r; } -- 1.8.3.1