integrate changes#9377,9385,9401 from mainline

       Subject: RE: 5.6.0 BUG: Lexical warnings aren't lexical

       If directory entries compare equal case-insensitively,
       retry case-sensitively.

       Subject: [PATCH] B::Terse and warnings

p4raw-link: @9401 on //depot/perl: 7272584d0d275e06fe4442e1b6aecb95109596e4
p4raw-link: @9385 on //depot/perl: fd713a85eb6c0ac3df6fa25ed6c5b990a5c3d174
p4raw-link: @9377 on //depot/perl: 244826ebc30b533e32f299fd464a9d2df6f38a1a

p4raw-id: //depot/maint-5.6/perl@9415
p4raw-integrated: from //depot/perl@9312 'copy in' ext/B/B/Terse.pm
	(@8427..) ext/File/Glob/bsd_glob.c (@9269..) 'merge in'
	ext/B/B.pm (@8242..) t/pragma/warn/perl (@8750..) gv.c
	(@9390..)

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 5f2cc9b..6a94768 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -131,6 +131,7 @@ sub objsym {
 
 sub walkoptree_exec {
     my ($op, $method, $level) = @_;
+    $level ||= 0;
     my ($sym, $ppname);
     my $prefix = "    " x $level;
     for (; $$op; $op = $op->next) {

diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm
index a7a071e..8f669b4 100644 (file)
--- a/ext/B/B/Terse.pm
+++ b/ext/B/B/Terse.pm
@@ -15,7 +15,7 @@ sub terse {
 }
 
 sub compile {
-    my $order = shift;
+    my $order = @_ ? shift : "";
     my @options = @_;
     B::clearsym();
     if (@options) {
@@ -37,7 +37,7 @@ sub compile {
 }
 
 sub indent {
-    my $level = shift;
+    my $level = @_ ? shift : 0;
     return "    " x $level;
 }
 

diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c
index 55f8312..a0becd1 100644 (file)
--- a/ext/File/Glob/bsd_glob.c
+++ b/ext/File/Glob/bsd_glob.c
@@ -545,13 +545,17 @@ ci_compare(const void *p, const void *q)
 {
     const char *pp = *(const char **)p;
     const char *qq = *(const char **)q;
+    int ci;
     while (*pp && *qq) {
        if (tolower(*pp) != tolower(*qq))
            break;
        ++pp;
        ++qq;
     }
-    return (tolower(*pp) - tolower(*qq));
+    ci = tolower(*pp) - tolower(*qq);
+    if (ci == 0)
+       return compare(p, q);
+    return ci;
 }
 
 static int

diff --git a/gv.c b/gv.c
index 23f75bd..984ce51 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -687,7 +687,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     gv_init(gv, stash, name, len, add & GV_ADDMULTI);
     gv_init_sv(gv, sv_type);
 
-    if (isLEXWARN_on && isALPHA(name[0]) && ! ckWARN(WARN_ONCE))
+    if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE) 
+                                           : (PL_dowarn & G_WARN_ON ) ) )
         GvMULTI_on(gv) ;
 
     /* set up magic where warranted */

diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl
index 4580749..b4a00ba 100644 (file)
--- a/t/pragma/warn/perl
+++ b/t/pragma/warn/perl
@@ -54,4 +54,19 @@ Name "main::z" used only once: possible typo at - line 6.
 use warnings 'once' ;
 $x = 3 ;
 EXPECT
+########
 
+# perl.c
+{ use warnings 'once' ; $x = 3 ; }
+$y = 3 ;
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+
+# perl.c
+$z = 3 ;
+BEGIN { $^W = 1 }
+{ no warnings 'once' ; $x = 3 ; }
+$y = 3 ;
+EXPECT
+Name "main::y" used only once: possible typo at - line 6.