diff options
| author | Gurusamy Sarathy <gsar@cpan.org> | 2001-03-28 17:13:01 +0000 |
|---|---|---|
| committer | Gurusamy Sarathy <gsar@cpan.org> | 2001-03-28 17:13:01 +0000 |
| commit | e9b26b4532b9227856c44ca3c39735cfdfa48eff (patch) | |
| tree | 553b860f949474c90283b670647460e1d02ec9d2 | |
| parent | 90571434fe71a9604ebc8f442b90a5224e672c5c (diff) | |
| download | perl-e9b26b4532b9227856c44ca3c39735cfdfa48eff.tar.gz | |
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..)
| -rw-r--r-- | ext/B/B.pm | 1 | ||||
| -rw-r--r-- | ext/B/B/Terse.pm | 4 | ||||
| -rw-r--r-- | ext/File/Glob/bsd_glob.c | 6 | ||||
| -rw-r--r-- | gv.c | 3 | ||||
| -rw-r--r-- | t/pragma/warn/perl | 15 |
5 files changed, 25 insertions, 4 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm index 5f2cc9b819..6a947686c6 100644 --- 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 a7a071e937..8f669b463f 100644 --- 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 55f8312186..a0becd1e14 100644 --- 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 @@ -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 45807499d6..b4a00bac41 100644 --- 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. |