diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/comp/parser.t | 26 | ||||
| -rw-r--r-- | t/op/concat.t | 19 | ||||
| -rwxr-xr-x | t/op/local.t | 4 | ||||
| -rw-r--r-- | t/op/localref.t | 85 | ||||
| -rwxr-xr-x | t/op/pat.t | 19 | ||||
| -rwxr-xr-x | t/op/subst.t | 13 | ||||
| -rw-r--r-- | t/run/switchC.t | 57 |
7 files changed, 211 insertions, 12 deletions
diff --git a/t/comp/parser.t b/t/comp/parser.t index 88f933c7a6..ad1c5b80bd 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -9,7 +9,7 @@ BEGIN { } require "./test.pl"; -plan( tests => 15 ); +plan( tests => 20 ); eval '%@x=0;'; like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' ); @@ -68,9 +68,23 @@ eval { is( $@, '', 'PL_lex_brackstack' ); { - undef $a; - undef @b; - my $a="a"; is("${a}{", "a{", "scope error #20716"); - my $a="a"; is("${a}[", "a[", "scope error #20716"); - my @b=("b"); is("@{b}{", "b{", "scope error #20716"); + # tests for bug #20716 + undef $a; + undef @b; + my $a="A"; + is("${a}{", "A{", "interpolation, qq//"); + is("${a}[", "A[", "interpolation, qq//"); + my @b=("B"); + is("@{b}{", "B{", "interpolation, qq//"); + is(qr/${a}{/, '(?-xism:A{)', "interpolation, qr//"); + my $c = "A{"; + $c =~ /${a}{/; + is($&, 'A{', "interpolation, m//"); + $c =~ s/${a}{/foo/; + is($c, 'foo', "interpolation, s/...//"); + $c =~ s/foo/${a}{/; + is($c, 'A{', "interpolation, s//.../"); + is(<<"${a}{", "A{ A[ B{\n", "interpolation, here doc"); +${a}{ ${a}[ @{b}{ +${a}{ } diff --git a/t/op/concat.t b/t/op/concat.t index 4813690d6b..c1a6e23e7e 100644 --- a/t/op/concat.t +++ b/t/op/concat.t @@ -18,7 +18,7 @@ sub ok { return $ok; } -print "1..12\n"; +print "1..18\n"; ($a, $b, $c) = qw(foo bar); @@ -87,3 +87,20 @@ ok("$c$a$c" eq "foo", "concatenate undef, fore and aft"); eval{"\x{1234}$pi"}; ok(!$@, "bug id 20001020.006, constant right"); } + +sub beq { use bytes; $_[0] eq $_[1]; } + +{ + # concat should not upgrade its arguments. + my($l, $r, $c); + + ($l, $r, $c) = ("\x{101}", "\x{fe}", "\x{101}\x{fe}"); + ok(beq($l.$r, $c), "concat utf8 and byte"); + ok(beq($l, "\x{101}"), "right not changed after concat u+b"); + ok(beq($r, "\x{fe}"), "left not changed after concat u+b"); + + ($l, $r, $c) = ("\x{fe}", "\x{101}", "\x{fe}\x{101}"); + ok(beq($l.$r, $c), "concat byte and utf8"); + ok(beq($l, "\x{fe}"), "right not changed after concat b+u"); + ok(beq($r, "\x{101}"), "left not changed after concat b+u"); +} diff --git a/t/op/local.t b/t/op/local.t index 6da03912e9..1bb8b8ac1b 100755 --- a/t/op/local.t +++ b/t/op/local.t @@ -45,10 +45,10 @@ print $a,@b,@c,%d,$x,$y; eval 'local($$e)'; print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 21\n"; -eval 'local(@$e)'; +eval '$e = []; local(@$e)'; print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n"; -eval 'local(%$e)'; +eval '$e = {}; local(%$e)'; print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n"; # Array and hash elements diff --git a/t/op/localref.t b/t/op/localref.t new file mode 100644 index 0000000000..9379575ede --- /dev/null +++ b/t/op/localref.t @@ -0,0 +1,85 @@ +#!./perl + +chdir 't' if -d 't'; +@INC = qw(. ../lib); +require "test.pl"; +plan( tests => 63 ); + +$aa = 1; +{ local $aa; $aa = 2; is($aa,2); } +is($aa,1); +{ local ${aa}; $aa = 3; is($aa,3); } +is($aa,1); +{ local ${"aa"}; $aa = 4; is($aa,4); } +is($aa,1); +$x = "aa"; +{ local ${$x}; $aa = 5; is($aa,5); undef $x; is($aa,5); } +is($aa,1); +$x = "a"; +{ local ${$x x2};$aa = 6; is($aa,6); undef $x; is($aa,6); } +is($aa,1); +$x = "aa"; +{ local $$x; $aa = 7; is($aa,7); undef $x; is($aa,7); } +is($aa,1); + +@aa = qw/a b/; +{ local @aa; @aa = qw/c d/; is("@aa","c d"); } +is("@aa","a b"); +{ local @{aa}; @aa = qw/e f/; is("@aa","e f"); } +is("@aa","a b"); +{ local @{"aa"}; @aa = qw/g h/; is("@aa","g h"); } +is("@aa","a b"); +$x = "aa"; +{ local @{$x}; @aa = qw/i j/; is("@aa","i j"); undef $x; is("@aa","i j"); } +is("@aa","a b"); +$x = "a"; +{ local @{$x x2};@aa = qw/k l/; is("@aa","k l"); undef $x; is("@aa","k l"); } +is("@aa","a b"); +$x = "aa"; +{ local @$x; @aa = qw/m n/; is("@aa","m n"); undef $x; is("@aa","m n"); } +is("@aa","a b"); + +%aa = qw/a b/; +{ local %aa; %aa = qw/c d/; is($aa{c},"d"); } +is($aa{a},"b"); +{ local %{aa}; %aa = qw/e f/; is($aa{e},"f"); } +is($aa{a},"b"); +{ local %{"aa"}; %aa = qw/g h/; is($aa{g},"h"); } +is($aa{a},"b"); +$x = "aa"; +{ local %{$x}; %aa = qw/i j/; is($aa{i},"j"); undef $x; is($aa{i},"j"); } +is($aa{a},"b"); +$x = "a"; +{ local %{$x x2};%aa = qw/k l/; is($aa{k},"l"); undef $x; is($aa{k},"l"); } +is($aa{a},"b"); +$x = "aa"; +{ local %$x; %aa = qw/m n/; is($aa{m},"n"); undef $x; is($aa{m},"n"); } +is($aa{a},"b"); + +sub test_err_localref () { + like($@,qr/Can't localize through a reference/,'error'); +} +$x = \$aa; +my $y = \$aa; +eval { local $$x; }; test_err_localref; +eval { local ${$x}; }; test_err_localref; +eval { local $$y; }; test_err_localref; +eval { local ${$y}; }; test_err_localref; +eval { local ${\$aa}; }; test_err_localref; +eval { local ${\'aa'}; }; test_err_localref; +$x = \@aa; +$y = \@aa; +eval { local @$x; }; test_err_localref; +eval { local @{$x}; }; test_err_localref; +eval { local @$y; }; test_err_localref; +eval { local @{$y}; }; test_err_localref; +eval { local @{\@aa}; }; test_err_localref; +eval { local @{[]}; }; test_err_localref; +$x = \%aa; +$y = \%aa; +eval { local %$x; }; test_err_localref; +eval { local %{$x}; }; test_err_localref; +eval { local %$y; }; test_err_localref; +eval { local %{$y}; }; test_err_localref; +eval { local %{\%aa}; }; test_err_localref; +eval { local %{{a=>1}}; };test_err_localref; diff --git a/t/op/pat.t b/t/op/pat.t index fe70e12725..40a265882c 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -6,7 +6,7 @@ $| = 1; -print "1..988\n"; +print "1..990\n"; BEGIN { chdir 't' if -d 't'; @@ -3108,5 +3108,20 @@ ok("bbbbac" =~ /$pattern/ && $1 eq 'a', "[perl #3547]"); ok ( "0" =~ /\p{N}+\z/, "[perl #19767] variant test" ); } -# last test 988 +{ + + $p = 1; + foreach (1,2,3,4) { + $p++ if /(??{ $p })/ + } + ok ($p == 5, "[perl #20683] (??{ }) returns stale values"); + { package P; $a=1; sub TIESCALAR { bless[] } sub FETCH { $a++ } } + tie $p, P; + foreach (1,2,3,4) { + /(??{ $p })/ + } + ok ( $p == 5, "(??{ }) returns stale values"); +} + +# last test 990 diff --git a/t/op/subst.t b/t/op/subst.t index 59c3d21b8d..f30f593e5a 100755 --- a/t/op/subst.t +++ b/t/op/subst.t @@ -7,7 +7,7 @@ BEGIN { } require './test.pl'; -plan( tests => 126 ); +plan( tests => 128 ); $x = 'foo'; $_ = "x"; @@ -516,3 +516,14 @@ is("<$_> <$s>", "<> <4>", "[perl #7806]"); $f =~ s/x/y/g; is($f, "yy", "[perl #17757]"); } + +# [perl #20684] returned a zero count +$_ = "1111"; +is(s/(??{1})/2/eg, 4, '#20684 s/// with (??{..}) inside'); + +# [perl #20682] @- not visible in replacement +$_ = "123"; +/(2)/; # seed @- with something else +s/(1)(2)(3)/$#- (@-)/; +is($_, "3 (0 0 1 2)", '#20682 @- not visible in replacement'); + diff --git a/t/run/switchC.t b/t/run/switchC.t new file mode 100644 index 0000000000..9283fa879b --- /dev/null +++ b/t/run/switchC.t @@ -0,0 +1,57 @@ +#!./perl -w + +# Tests for the command-line switches + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + unless (find PerlIO::Layer 'perlio') { + print "1..0 # Skip: not perlio\n"; + exit 0; + } +} + +require "./test.pl"; + +plan(tests => 6); + +my $r; + +my @tmpfiles = (); +END { unlink @tmpfiles } + +$r = runperl( switches => [ '-CO', '-w' ], + prog => 'print chr(256)', + stderr => 1 ); +is( $r, "\xC4\x80", '-CO: no warning on UTF-8 output' ); + +$r = runperl( switches => [ '-CI', '-w' ], + prog => 'print ord(<STDIN>)', + stderr => 1, + stdin => chr(256) ); +is( $r, 256, '-CI: read in UTF-8 output' ); + +$r = runperl( switches => [ '-CE', '-w' ], + prog => 'warn chr(256), qq(\n)', + stderr => 1 ); +chomp $r; +is( $r, "\xC4\x80", '-CE: UTF-8 stderr' ); + +$r = runperl( switches => [ '-Co', '-w' ], + prog => 'open(F, q(>out)); print F chr(256); close F', + stderr => 1 ); +is( $r, '', '-Co: auto-UTF-8 open for output' ); + +push @tmpfiles, "out"; + +$r = runperl( switches => [ '-Ci', '-w' ], + prog => 'open(F, q(<out)); print ord(<F>); close F', + stderr => 1 ); +is( $r, 256, '-Ci: auto-UTF-8 open for input' ); + +$r = runperl( switches => [ '-CA', '-w' ], + prog => 'print ord shift', + stderr => 1, + args => [ chr(256) ] ); +is( $r, 256, '-CA: @ARGV' ); + |