dVAR;
OP *kid;
const char* useless = NULL;
+ U32 useless_is_utf8 = 0;
SV* sv;
U8 want;
SV* msv = sv_2mortal(Perl_newSVpvf(aTHX_
"a constant (%"SVf")", sv));
useless = SvPV_nolen(msv);
+ useless_is_utf8 = SvUTF8(msv);
}
else
useless = "a constant (undef)";
return scalar(o);
}
if (useless)
- Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless);
+ Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %"SVf" in void context",
+ newSVpvn_flags(useless, strlen(useless),
+ SVs_TEMP | ( useless_is_utf8 ? SVf_UTF8 : 0 )));
return o;
}
if (PL_parser && PL_parser->copline != NOLINE)
CopLINE_set(PL_curcop, PL_parser->copline);
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
- CvCONST(cv) ? "Constant subroutine %s redefined"
- : "Subroutine %s redefined", name);
+ CvCONST(cv) ? "Constant subroutine %"SVf" redefined"
+ : "Subroutine %"SVf" redefined",
+ SVfARG(cSVOPo->op_sv));
CopLINE_set(PL_curcop, oldline);
}
#ifdef PERL_MAD
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
(const char *)
(CvCONST(cv)
- ? "Constant subroutine %s::%s redefined"
- : "Subroutine %s::%s redefined"),
- HvNAME_get(GvSTASH((const GV *)dstr)),
- GvENAME(MUTABLE_GV(dstr)));
+ ? "Constant subroutine %"SVf"::%"SVf" redefined"
+ : "Subroutine %"SVf"::%"SVf" redefined"),
+ SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(GvSTASH((const GV *)dstr))))),
+ SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(MUTABLE_GV(dstr))))));
}
}
if (!intro)
Bareword "foo" not allowed while "strict subs" in use at (re_eval 1) line 1.
Compilation failed in regexp at - line 3.
########
+# Regexp compilation errors weren't UTF-8 clean
+use strict 'subs';
+use utf8;
+use open qw( :utf8 :std );
+qr/(?{my $x=fòò})/;
+EXPECT
+Bareword "fòò" not allowed while "strict subs" in use at (re_eval 1) line 1.
+Compilation failed in regexp at - line 5.
+########
# [perl #27628] strict 'subs' didn't warn on bareword array index
use strict 'subs';
my $x=$a[FOO];
########
# Check compile time scope of strict vars pragma
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+{
+ no strict ;
+ $jòè = 1 ;
+}
+$jòè = 1 ;
+EXPECT
+Variable "$jòè" is not imported at - line 10.
+Global symbol "$jòè" requires explicit package name at - line 10.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
no strict;
{
use strict 'vars' ;
Compilation failed in require at - line 2.
########
+--FILE-- abc
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+$jòè = 1 ;
+1;
+--FILE--
+use utf8;
+use open qw( :utf8 :std );
+$jòè = 1 ;
+require "./abc";
+EXPECT
+Variable "$jòè" is not imported at ./abc line 4.
+Global symbol "$jòè" requires explicit package name at ./abc line 4.
+Compilation failed in require at - line 4.
+########
+
--FILE-- abc.pm
use strict 'vars' ;
$joe = 1 ;
########
--FILE-- abc.pm
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+$jòè = 1 ;
+1;
+--FILE--
+use utf8;
+use open qw( :utf8 :std );
+$jòè = 1 ;
+use abc;
+EXPECT
+Variable "$jòè" is not imported at abc.pm line 4.
+Global symbol "$jòè" requires explicit package name at abc.pm line 4.
+Compilation failed in require at - line 4.
+BEGIN failed--compilation aborted at - line 4.
+########
+
+--FILE-- abc.pm
package Burp;
use strict;
$a = 1;$f = 1;$k = 1; # just to get beyond the limit...
########
# Check scope of pragma with eval
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+eval {
+ no strict ;
+ $jòè = 1 ;
+};
+print STDERR $@;
+$jòè = 1 ;
+EXPECT
+Variable "$jòè" is not imported at - line 11.
+Global symbol "$jòè" requires explicit package name at - line 11.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
no strict ;
eval '
$joe = 1 ;
Execution of - aborted due to compilation errors.
########
+# strict vars with elapsed our - error
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+sub fòò {
+ our $frèd;
+ $frèd;
+}
+$frèd ;
+EXPECT
+Variable "$frèd" is not imported at - line 10.
+Global symbol "$frèd" requires explicit package name at - line 10.
+Execution of - aborted due to compilation errors.
+########
+
# nested our with local - no error
$fred = 1;
use strict 'vars';
Global symbol "$foo" requires explicit package name at (re_eval 1) line 1.
Compilation failed in regexp at - line 3.
########
+# Regex compilation errors weren't UTF-8 clean.
+use strict 'vars';
+use utf8;
+use open qw( :utf8 :std );
+qr/(?{$fòò++})/;
+EXPECT
+Global symbol "$fòò" requires explicit package name at (re_eval 1) line 1.
+Compilation failed in regexp at - line 5.
+########
# [perl #73712] 'Variable is not imported' should be suppressible
$dweck;
use strict 'vars';
Mandatory Warnings ALL TODO
------------------
- Had to create %s unexpectedly [gv_fetchpv]
+ Had to create %SVf unexpectedly [gv_fetchpv]
Attempt to free unreferenced glob pointers [gp_free]
__END__
Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
########
# gv.c
+use utf8;
+use open qw( :utf8 :std );
+sub Oᕞʀ::AUTOLOAD { 1 } sub Oᕞʀ::fᕃƌ {}
+@ISA = qw(Oᕞʀ) ;
+use warnings 'deprecated' ;
+fᕃƌ() ;
+EXPECT
+Use of inherited AUTOLOAD for non-method main::fᕃƌ() is deprecated at - line 7.
+########
+# gv.c
$a = ${"#"};
$a = ${"*"};
no warnings 'deprecated' ;
EXPECT
$# is no longer supported at - line 2.
$* is no longer supported at - line 3.
+########
+# gv.c
+use warnings 'syntax' ;
+use utf8;
+use open qw( :utf8 :std );
+package Y;
+@ISA = qw(Fred); joe()
+EXPECT
+Can't locate package Fred for @Y::ISA at - line 6.
+Undefined subroutine &Y::joe called at - line 6.
Useless use of a constant (undef) in void context at - line 8.
########
# op.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'void' ;
+"àḆc"; # OP_CONST
+"Ẋ" . "ƴ"; # optimized to OP_CONST
+FOO; # Bareword optimized to OP_CONST
+use constant ů => undef;
+ů;
+5 || print "bad\n"; # test OPpCONST_SHORTCIRCUIT
+print "boo\n" if ů; # test OPpCONST_SHORTCIRCUIT
+no warnings 'void' ;
+"àḆc"; # OP_CONST
+"Ẋ" . "ƴ"; # optimized to OP_CONST
+EXPECT
+Useless use of a constant (àḆc) in void context at - line 5.
+Useless use of a constant (Ẋƴ) in void context at - line 6.
+Useless use of a constant (FOO) in void context at - line 7.
+Useless use of a constant (undef) in void context at - line 9.
+########
+# op.c
#
use warnings 'misc' ;
my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;my $d = 'test';
split /y/, "z";
EXPECT
Useless use of split in void context at - line 5.
+########
+# op.c
+use warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd {}
+sub frèd {}
+no warnings 'redefine' ;
+sub frèd {}
+EXPECT
+Subroutine frèd redefined at - line 6.
+########
+# op.c
+use warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd () { 1 }
+sub frèd () { 1 }
+no warnings 'redefine' ;
+sub frèd () { 1 }
+EXPECT
+Constant subroutine frèd redefined at - line 6.
+########
+# op.c
+no warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd () { 1 }
+sub frèd () { 2 }
+EXPECT
+Constant subroutine frèd redefined at - line 6.
+########
+# op.c
+no warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd () { 1 }
+*frèd = sub () { 2 };
+EXPECT
+Constant subroutine main::frèd redefined at - line 6.
+########
+# op.c
+use warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᚠርƊ {}
+sub ᚠርƊ {}
+no warnings 'redefine' ;
+sub ᚠርƊ {}
+EXPECT
+Subroutine ᚠርƊ redefined at - line 6.
+########
+# op.c
+use warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᚠርƊ () { 1 }
+sub ᚠርƊ () { 1 }
+no warnings 'redefine' ;
+sub ᚠርƊ () { 1 }
+EXPECT
+Constant subroutine ᚠርƊ redefined at - line 6.
+########
+# op.c
+no warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᚠርƊ () { 1 }
+sub ᚠርƊ () { 2 }
+EXPECT
+Constant subroutine ᚠርƊ redefined at - line 6.
+########
+# op.c
+no warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᚠርƊ () { 1 }
+*ᚠርƊ = sub () { 2 };
+EXPECT
+Constant subroutine main::ᚠርƊ redefined at - line 6.
+########