summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/lib/charnames/alias8
-rw-r--r--t/lib/warnings/op28
-rw-r--r--t/lib/warnings/toke132
-rw-r--r--t/re/reg_email.t2
-rw-r--r--t/uni/labels.t82
-rw-r--r--t/uni/opcroak.t44
-rw-r--r--t/uni/parser.t8
7 files changed, 299 insertions, 5 deletions
diff --git a/t/lib/charnames/alias b/t/lib/charnames/alias
index fb1a914fda..75280be7b3 100644
--- a/t/lib/charnames/alias
+++ b/t/lib/charnames/alias
@@ -338,3 +338,11 @@ charnames::viacode(0x41);
EXPECT
OPTIONS regex
$
+########
+# NAME no extraneous warning [perl #11560]
+use warnings;
+use charnames ();
+print charnames::viacode(0x80), "\n";
+EXPECT
+OPTIONS regex
+PADDING CHARACTER
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 8f579201eb..de74d2e360 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -857,7 +857,7 @@ use open qw( :utf8 :std );
use warnings;
eval "sub fòò (\$\0) {}";
EXPECT
-Illegal character in prototype for main::fòò : $\x{0} at (eval 1) line 1.
+Illegal character in prototype for main::fòò : $\0 at (eval 1) line 1.
########
# op.c
use utf8;
@@ -865,7 +865,7 @@ use open qw( :utf8 :std );
use warnings;
eval "sub foo (\0) {}";
EXPECT
-Illegal character in prototype for main::foo : \x{0} at (eval 1) line 1.
+Illegal character in prototype for main::foo : \0 at (eval 1) line 1.
########
# op.c
use utf8;
@@ -882,7 +882,21 @@ use open qw( :utf8 :std );
use warnings;
BEGIN { eval "sub foo (\0) {}"; }
EXPECT
-Illegal character in prototype for main::foo : \x{0} at (eval 1) line 1.
+Illegal character in prototype for main::foo : \0 at (eval 1) line 1.
+########
+# op.c
+use warnings;
+eval "sub foo (\xAB) {}";
+EXPECT
+Illegal character in prototype for main::foo : \x{ab} at (eval 1) line 1.
+########
+# op.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+BEGIN { eval "sub foo (\x{30cb}) {}"; }
+EXPECT
+Illegal character in prototype for main::foo : \x{30cb} at (eval 1) line 1.
########
# op.c
use utf8;
@@ -991,6 +1005,14 @@ join /---/, 'x', 'y', 'z';
EXPECT
/---/ should probably be written as "---" at - line 3.
########
+# op.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+join /～～～/, 'x', 'y', 'z';
+EXPECT
+/～～～/ should probably be written as "～～～" at - line 5.
+########
# op.c [Perl_peep]
use warnings 'prototype' ;
fred() ;
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index a6841d2d09..dd8dc3d517 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -616,6 +616,30 @@ EXPECT
Bareword "FRED::" refers to nonexistent package at bar line 25.
########
# toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'bareword' ;
+#line 25 "bar"
+$a = FRÈD:: ;
+no warnings 'bareword' ;
+#line 25 "bar"
+$a = FRÈD:: ;
+EXPECT
+Bareword "FRÈD::" refers to nonexistent package at bar line 25.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'bareword' ;
+#line 25 "bar"
+$a = ϞϞϞ:: ;
+no warnings 'bareword' ;
+#line 25 "bar"
+$a = ϞϞϞ:: ;
+EXPECT
+Bareword "ϞϞϞ::" refers to nonexistent package at bar line 25.
+########
+# toke.c
use warnings 'ambiguous' ;
sub time {}
my $a = time() ;
@@ -692,11 +716,77 @@ Ambiguous use of -fred resolved as -&fred() at - line 9.
Ambiguous use of -fred resolved as -&fred() at - line 11.
########
# toke.c
+use utf8;
+use open qw( :utf8 :std );
+sub frèd {};
+-frèd ;
+EXPECT
+Ambiguous use of -frèd resolved as -&frèd() at - line 5.
+########
+# toke.c
+$^W = 0 ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd {} ;
+-frèd ;
+{
+ no warnings 'ambiguous' ;
+ -frèd ;
+ use warnings 'ambiguous' ;
+ -frèd ;
+}
+-frèd ;
+EXPECT
+Ambiguous use of -frèd resolved as -&frèd() at - line 6.
+Ambiguous use of -frèd resolved as -&frèd() at - line 11.
+Ambiguous use of -frèd resolved as -&frèd() at - line 13.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+sub ᒍᒘᒊ {};
+-ᒍᒘᒊ ;
+EXPECT
+Ambiguous use of -ᒍᒘᒊ resolved as -&ᒍᒘᒊ() at - line 5.
+########
+# toke.c
+$^W = 0 ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᒍᒘᒊ {} ;
+-ᒍᒘᒊ ;
+{
+ no warnings 'ambiguous' ;
+ -ᒍᒘᒊ ;
+ use warnings 'ambiguous' ;
+ -ᒍᒘᒊ ;
+}
+-ᒍᒘᒊ ;
+EXPECT
+Ambiguous use of -ᒍᒘᒊ resolved as -&ᒍᒘᒊ() at - line 6.
+Ambiguous use of -ᒍᒘᒊ resolved as -&ᒍᒘᒊ() at - line 11.
+Ambiguous use of -ᒍᒘᒊ resolved as -&ᒍᒘᒊ() at - line 13.
+########
+# toke.c
open FOO || time;
open local *FOO; # should be ok
EXPECT
Precedence problem: open FOO should be open(FOO) at - line 2.
########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+open FÒÒ || time;
+EXPECT
+Precedence problem: open FÒÒ should be open(FÒÒ) at - line 4.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+open ᒍOO || time;
+EXPECT
+Precedence problem: open ᒍOO should be open(ᒍOO) at - line 4.
+########
# toke.c (and [perl #16184])
open FOO => "<&0"; close FOO;
EXPECT
@@ -719,6 +809,40 @@ Precedence problem: open FOO should be open(FOO) at - line 10.
########
# toke.c
$^W = 0 ;
+use utf8;
+use open qw( :utf8 :std );
+open FÒÒ || time;
+{
+ no warnings 'precedence' ;
+ open FÒÒ || time;
+ use warnings 'precedence' ;
+ open FÒÒ || time;
+}
+open FÒÒ || time;
+EXPECT
+Precedence problem: open FÒÒ should be open(FÒÒ) at - line 5.
+Precedence problem: open FÒÒ should be open(FÒÒ) at - line 10.
+Precedence problem: open FÒÒ should be open(FÒÒ) at - line 12.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+$^W = 0 ;
+open ᒍÒÒ || time;
+{
+ no warnings 'precedence' ;
+ open ᒍÒÒ || time;
+ use warnings 'precedence' ;
+ open ᒍÒÒ || time;
+}
+open ᒍÒÒ || time;
+EXPECT
+Precedence problem: open ᒍÒÒ should be open(ᒍÒÒ) at - line 5.
+Precedence problem: open ᒍÒÒ should be open(ᒍÒÒ) at - line 10.
+Precedence problem: open ᒍÒÒ should be open(ᒍÒÒ) at - line 12.
+########
+# toke.c
+$^W = 0 ;
*foo *foo ;
{
no warnings 'ambiguous' ;
@@ -1118,3 +1242,11 @@ no warnings 'ambiguous' ;
$a = ${f렏} ;
EXPECT
Ambiguous use of ${f렏} resolved to $f렏 at - line 6.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+CORE::렏;
+EXPECT
+CORE::렏 is not a keyword at - line 5.
diff --git a/t/re/reg_email.t b/t/re/reg_email.t
index 27f1f35591..a498585794 100644
--- a/t/re/reg_email.t
+++ b/t/re/reg_email.t
@@ -30,7 +30,7 @@ my $email = qr {
(?<dcontent> (?&dtext) | (?&quoted_pair))
(?<dtext> (?&NO_WS_CTL) | [\x21-\x5a\x5e-\x7e])
- (?<atext> (?&ALPHA) | (?&DIGIT) | [!#\$%&'*+-/=?^_`{|}~])
+ (?<atext> (?&ALPHA) | (?&DIGIT) | [-!#\$%&'*+/=?^_`{|}~])
(?<atom> (?&CFWS)? (?&atext)+ (?&CFWS)?)
(?<dot_atom> (?&CFWS)? (?&dot_atom_text) (?&CFWS)?)
(?<dot_atom_text> (?&atext)+ (?: \. (?&atext)+)*)
diff --git a/t/uni/labels.t b/t/uni/labels.t
new file mode 100644
index 0000000000..e3ff938174
--- /dev/null
+++ b/t/uni/labels.t
@@ -0,0 +1,82 @@
+#!./perl
+
+# Tests for labels in UTF-8
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+use feature qw 'unicode_strings evalbytes';
+
+use charnames qw( :full );
+
+plan(9);
+
+ＬＡＢＥＬ: {
+ pass("Sanity check, UTF-8 labels don't throw a syntax error.");
+}
+
+
+SKIP: {
+ skip_if_miniperl("no dynamic loading, no Encode");
+ no warnings 'exiting';
+ require Encode;
+
+ my $prog = 'last ＬＯＯＰ;';
+
+ ＬＯＯＰ: {
+ eval $prog;
+ }
+ is $@, '', "last with a UTF-8 label works,";
+
+ ＬＯＯＰ: {
+ Encode::_utf8_off($prog);
+ evalbytes $prog;
+ like $@, qr/^Unrecognized character/, "..but turn off the UTF-8 flag and it explodes";
+ }
+}
+
+{
+ no warnings 'exiting';
+
+ eval "last Ｅ";
+ like $@, qr/Label not found for "last Ｅ" at/u, "last's error is UTF-8 clean";
+
+ eval "redo Ｅ";
+ like $@, qr/Label not found for "redo Ｅ" at/u, "redo's error is UTF-8 clean";
+
+ eval "next Ｅ";
+ like $@, qr/Label not found for "next Ｅ" at/u, "next's error is UTF-8 clean";
+}
+
+my $d = 4;
+LÁBEL: {
+ my $prog = "redo L\N{LATIN CAPITAL LETTER A WITH ACUTE}BEL";
+
+ if ($d % 2) {
+ utf8::downgrade($prog);
+ }
+ if ($d--) {
+ no warnings 'exiting';
+ eval $prog;
+ }
+}
+
+is $@, '', "redo to downgradeable labels works";
+is $d, -1, "Latin-1 labels reachable regardless of UTF-8ness";
+
+{
+ no warnings;
+ goto ここ;
+
+ if (undef) {
+ ここ: {
+ pass("goto UTF-8 LABEL works.");
+ }
+ }
+}
diff --git a/t/uni/opcroak.t b/t/uni/opcroak.t
new file mode 100644
index 0000000000..29909d7cd6
--- /dev/null
+++ b/t/uni/opcroak.t
@@ -0,0 +1,44 @@
+#!./perl
+
+#
+# tests for op.c generated croaks
+#
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+
+plan( tests => 5 );
+
+eval qq!sub \x{30cb} (\$) {} \x{30cb}()!;
+like $@, qr/Not enough arguments for main::\x{30cb}/u, "Not enough arguments croak is UTF-8 clean";
+
+eval qq!sub \x{30cc} (\$) {} \x{30cc}(1, 2)!;
+like $@, qr/Too many arguments for main::\x{30cc}/u, "Too many arguments croak is UTF-8 clean";
+
+eval qq!sub \x{30cd} (\Q\%\E) { 1 } \x{30cd}(1);!;
+like $@, qr/Type of arg 1 to main::\x{30cd} must be/u, "bad type croak is UTF-8 clean";
+
+ eval <<'END_FIELDS';
+ {
+ package ＦŌŌ {
+ use fields qw( a b );
+ sub new { bless {}, shift }
+ }
+ }
+END_FIELDS
+
+for (
+ [ element => 'my ＦŌŌ $bàr = ＦŌŌ->new; $bàr->{クラス};' ],
+ [ slice => 'my ＦŌŌ $bàr = ＦŌŌ->new; @{$bàr}{ qw( a クラス ) };' ]
+ ) {
+ eval $_->[1];
+
+ like $@, qr/No such class field "クラス" in variable \$bàr of type ＦŌŌ/, "$_->[0]: no such field error is UTF-8 clean";
+}
diff --git a/t/uni/parser.t b/t/uni/parser.t
index 256864cb80..63c2deba68 100644
--- a/t/uni/parser.t
+++ b/t/uni/parser.t
@@ -7,7 +7,7 @@ BEGIN {
require './test.pl';
}
-plan (tests => 45);
+plan (tests => 47);
use utf8;
use open qw( :utf8 :std );
@@ -138,3 +138,9 @@ is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't";
eval qq!print \x{30cb}, "comma""!;
like $@, qr/No comma allowed after filehandle/, "No comma allowed after filehandle triggers correctly for UTF-8 filehandles.";
}
+
+# tests for "Bad name"
+eval q{ Ｆｏｏ::$bar };
+like( $@, qr/Bad name after Ｆｏｏ::/, 'Bad name after Ｆｏｏ::' );
+eval q{ Ｆｏｏ''bar };
+like( $@, qr/Bad name after Ｆｏｏ'/, 'Bad name after Ｆｏｏ\'' );
View Lorry Controller Status