integrate changes#2254,2259,2335,2345,2348,2361,2368,2380 from mainline

win32_recvfrom() compatibility fix

From: "Kurt D. Starsinic" <kstar@chapin.edu>
Subject: Re: [PATCH] Re: pod2man bug in date generated line
To: Albert Dvornik <bert@genscan.com>, "Larry W. Virden" <lvirden@cas.org>
Cc: perlbug@perl.com
Date: 20 Nov 1998 21:30:17 +0200
Message-ID: <MLIST_19981120131523.A464@O2.chapin.edu>

make $1 et al readonly under threads; make C<undef $1> fail like
C<$1 = undef> does

fix typo in pp_defined() causing C<defined %tied> to fail

more conservative version of changes#2345,2346,2347; those break
C<defined(@{"foo::ISA"})> which seems to be extensively used in
the libs :-(

fix uninitialized warnings
	From: Brian Callaghan <callagh@itginc.com>
	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 <Swen.Thuemmler@paderlinx.de>;
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..)

diff --git a/gv.c b/gv.c
index c5ee79a..a4b0b43 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 (file)
--- 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;
 }