In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/9e14fb1f5a651020fa073ddc425c1bad72d1b6d7?hp=f734918a4cae24e1ddecd84751b1497af5d56d9c>
- Log ----------------------------------------------------------------- commit 9e14fb1f5a651020fa073ddc425c1bad72d1b6d7 Author: Dan Collins <[email protected]> Date: Wed Sep 21 10:08:26 2016 -0400 t/op/blocks.t: tests for RT #113934 M t/op/blocks.t commit 3c37a496f168181fb09a3c0847928717219df5ac Author: Dan Collins <[email protected]> Date: Sat Jul 16 18:49:34 2016 -0400 t/op/goto.t: tests for RT #45091 M t/op/goto.t commit 5cc9a776e52468815e90db4dbea4a8f3e941e73f Author: Dan Collins <[email protected]> Date: Fri Jul 15 23:34:21 2016 -0400 t/lib/overload_fallback.t: tests for RT #43356 M t/lib/overload_fallback.t commit 68ca57d4016864ee944c3741691eb79430c8c44f Author: Dan Collins <[email protected]> Date: Thu Jul 14 16:23:52 2016 -0400 t/op/threads.t: tests for RT #41121 M t/op/threads.t commit 5422beb6e3e14c2ad0fbf99dc060c89dcaa36ad5 Author: Dan Collins <[email protected]> Date: Thu Jul 7 22:56:38 2016 -0400 t/op/threads.t: tests for RT #36664 M t/op/threads.t commit 1994b2149827c9436ce57a14ec7545e836d1c857 Author: Dan Collins <[email protected]> Date: Tue Jul 5 19:32:56 2016 -0400 t/re/subst.t: tests for RT #23624 M t/re/subst.t commit cf8fa7337dbf6fe40dea123f1758112f579284c2 Author: Dan Collins <[email protected]> Date: Tue Jul 5 16:29:10 2016 -0400 t/re/pat.t: tests for RT #21491 M t/re/pat.t commit 9c2603366a504b26c747cb747e1e35da9ed6d086 Author: Dan Collins <[email protected]> Date: Mon Jul 4 19:33:29 2016 -0400 t/lib/warnings/op: tests for RT #6870 M t/lib/warnings/op commit 5072d9dd38a0e9f440451f559acc39dc61d78604 Author: Dan Collins <[email protected]> Date: Mon Jul 4 13:45:37 2016 -0400 t/op/local.t: tests for RT #7615 M t/op/local.t commit c77848795108386eb396f1469c801e621ac4291b Author: Dan Collins <[email protected]> Date: Mon Jul 4 13:36:45 2016 -0400 t/io/socket.t: tests for RT #7614 M t/io/socket.t commit e73f998466b1fa14c2ea2ef516453abf7ce76c9d Author: Dan Collins <[email protected]> Date: Mon Jul 4 13:18:21 2016 -0400 t/op/local.t: tests for RT #7411 M t/op/local.t commit 7e4664292bd1d9af2541e987ed7edc773021d615 Author: Dan Collins <[email protected]> Date: Mon Jul 4 12:15:32 2016 -0400 t/op/caller.t: tests for RT #7165 M t/op/caller.t commit 4ef64d714651f0cbe79047cef0c3d263bb96c4ff Author: Dan Collins <[email protected]> Date: Sun Jul 3 22:43:49 2016 -0400 t/op/die.t: tests for RT #4821 M t/op/die.t commit 554b0b9d534bae827792b9530dc9a88c5fd2834f Author: Dan Collins <[email protected]> Date: Sun Jul 3 21:51:58 2016 -0400 t/lib/warnings/toke: tests for RT #4346 M t/lib/warnings/toke commit a6514bfa009ac2f00ce9d4706d8ed1a4d19d1910 Author: Dan Collins <[email protected]> Date: Sun Jul 3 20:18:12 2016 -0400 t/op/attrs.t: tests for RT 3605 Maybe this should be in a different file? M t/op/attrs.t commit ea41dae91e28ff5da754ab053c621ec40db5705c Author: Dan Collins <[email protected]> Date: Sun Jul 3 16:38:00 2016 -0400 t/op/bless.t: tests for RT #3305 and RT #3306 M t/op/bless.t commit f35ddf907306e8905ee293df4826f67a9fe5e1c5 Author: Dan Collins <[email protected]> Date: Sun Jul 3 19:09:04 2016 -0400 t/uni/overload.t: test for RT #3270 M t/uni/overload.t commit 111da7867221d4c747d002c775d64f4cc5c00f80 Author: Dan Collins <[email protected]> Date: Sun Jul 3 18:53:27 2016 -0400 t/uni/overload.t: test for RT 3054: might segfault. This one may be a bit dangerous. It is also one of many bugs involving a segfault due to a C stack overflow. M t/uni/overload.t commit a5fd18fc405e67ffaf10d634ba8dcb2128cad88a Author: Dan Collins <[email protected]> Date: Sun Jul 3 18:13:45 2016 -0400 t/op/blocks.t: add test for RT #2917 M t/op/blocks.t commit 05e36430c132ea3d59f27ae030da00807c91c723 Author: Dan Collins <[email protected]> Date: Sun Jul 3 18:00:23 2016 -0400 t/op/blocks.t: add test for RT #2754 M t/op/blocks.t commit 6527b78b23e4dc7b8c394dd35e82ff8dcf343f2a Author: Dan Collins <[email protected]> Date: Sun Jul 3 16:57:07 2016 -0400 t/op/for.t: RT #2166: Actually run the test so we know if behavior changes M t/op/for.t commit 224656165d671982b1d7e21b794a36111ce6fd59 Author: Dan Collins <[email protected]> Date: Sun Jul 3 17:06:41 2016 -0400 t/op/local.t: Unknown RT#, but appears to be fixed. Blame says not edited since 2005. M t/op/local.t commit f0ccc921ae3482c310d9c99243b7a52f8dbca945 Author: Dan Collins <[email protected]> Date: Sun Jul 3 17:01:04 2016 -0400 t/op/for.t: RT #1085: ticket 'resolved' but test was still 'todo' M t/op/for.t commit 6516dd561a94d09eee0da43e947e151c269139a4 Author: Dan Collins <[email protected]> Date: Thu Oct 20 12:37:15 2016 -0400 t/op/attrs.t: Fixup for 7fe45fb9 - should be a semicolon M t/op/attrs.t ----------------------------------------------------------------------- Summary of changes: t/io/socket.t | 9 ++++++++ t/lib/overload_fallback.t | 19 +++++++++++++++- t/lib/warnings/op | 16 +++++++++++++ t/lib/warnings/toke | 43 +++++++++++++++++++++++++++++++++++ t/op/attrs.t | 11 ++++++++- t/op/bless.t | 58 ++++++++++++++++++++++++++++++++++++++++++++++- t/op/blocks.t | 16 ++++++++++++- t/op/caller.t | 18 ++++++++++++++- t/op/die.t | 9 +++++++- t/op/for.t | 11 ++------- t/op/goto.t | 29 +++++++++++++++++++++++- t/op/local.t | 27 +++++++++++++++++++--- t/op/threads.t | 20 +++++++++++++++- t/re/pat.t | 6 ++++- t/re/subst.t | 30 +++++++++++++++++++++++- t/uni/overload.t | 21 ++++++++++++++++- 16 files changed, 320 insertions(+), 23 deletions(-) diff --git a/t/io/socket.t b/t/io/socket.t index 0783a77..0629c64 100644 --- a/t/io/socket.t +++ b/t/io/socket.t @@ -154,6 +154,14 @@ SKIP: is(0+$!, Errno::EMFILE(), "check correct errno for too many files"); } +{ + my $sock; + my $proto = getprotobyname('tcp'); + socket($sock, PF_INET, SOCK_STREAM, $proto); + accept($sock, $sock); + ok('RT #7614: still alive after accept($sock, $sock)'); +} + done_testing(); my @child_tests; @@ -172,3 +180,4 @@ sub is_child { sub end_child { print @child_tests; } + diff --git a/t/lib/overload_fallback.t b/t/lib/overload_fallback.t index 6b50042..a72d499 100644 --- a/t/lib/overload_fallback.t +++ b/t/lib/overload_fallback.t @@ -1,6 +1,12 @@ use warnings; use strict; -use Test::Simple tests => 2; + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require './test.pl'; + plan( tests => 3 ); +} use overload '""' => sub { 'stringvalue' }, fallback => 1; @@ -16,3 +22,14 @@ use overload '+' => sub { die "unused"; }; my $x = bless {}, 'main'; ok (eval {$x eq 'stringvalue'}, 'fallback worked again'); +TODO: { + local $::TODO = 'RT #43356: Autogeneration of ++ is incorrect'; + fresh_perl_is(<<'EOC', '2', {}, 'RT #43356: Autogeneration of ++'); +use overload + "0+" => sub { ${$_[0]} }, + "=" => sub { ${$_[0]} }, + fallback => 1; +my $value = bless \(my $dummy = 1), __PACKAGE__; +print ++$value; +EOC +} diff --git a/t/lib/warnings/op b/t/lib/warnings/op index cc0cf46..aba9c58 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -2083,3 +2083,19 @@ my $x2 = !A || !B; # warning-free, because upper-case won't clash EXPECT Unquoted string "a" may clash with future reserved word at - line 2. Unquoted string "b" may clash with future reserved word at - line 2. +######## +# RT #6870: Odd parsing of do...for... +# This was really more a tokenizer bug, but it manifests as spurious warnings +use warnings; +no warnings 'reserved'; +$a=do xa for ax; +do "xa" for ax; +do xa for ax; +do xa for "ax"; +do xa for sin(1); +do xa for (sin(1)); +do xa for "sin"; +do xa for qq(sin); +do xa for my $a; +do xa for my @a; +EXPECT diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 10f20f9..3e829c7 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -1511,3 +1511,46 @@ my $v = ð - 5; EXPECT OPTION regex (Wide character.*\n)?Warning: Use of "ð" without parentheses is ambiguous +######## +# RT #4346 Case 1: Warnings for print (...) +# TODO RT #4346: Warnings for print(...) are inconsistent +use warnings; +print ("((\n"); +print (">>\n"); +EXPECT +print (...) interpreted as function at - line 3. +print (...) interpreted as function at - line 4. +(( +>> +######## +# RT #4346 Case 2: Warnings for print (...) +use warnings; +print ("((\n"); +print (">>\n") +EXPECT +print (...) interpreted as function at - line 3. +print (...) interpreted as function at - line 4. +(( +>> +######## +# RT #4346 Case 3: Warnings for print (...) +# TODO RT #4346: Warnings for print(...) are inconsistent +use warnings; +print (">>\n"); +print ("((\n"); +EXPECT +print (...) interpreted as function at - line 3. +print (...) interpreted as function at - line 4. +>> +(( +######## +# RT #4346 Case 4: Warnings for print (...) +# TODO RT #4346: Warnings for print(...) are inconsistent +use warnings; +print (")\n"); +print ("))\n"); +EXPECT +print (...) interpreted as function at - line 3. +print (...) interpreted as function at - line 4. +) +)) diff --git a/t/op/attrs.t b/t/op/attrs.t index 13359bf..6f7d014 100644 --- a/t/op/attrs.t +++ b/t/op/attrs.t @@ -478,6 +478,15 @@ fresh_perl_like( qr/^Unterminated attribute parameter in attribute list at - line 1\.$/, { stderr => 1 }, 'RT #129086 attr(00000' -), +); + +TODO: { + local $TODO = 'RT #3605: Attribute syntax causes parsing errors near my $var :'; + my $out = runperl(prog => <<'EOP', stderr => 1); + $ref = \($1 ? my $var : my $othervar); +EOP + unlike($out, qr/Invalid separator character/, 'RT #3605: Errors near attribute colon need a better error message'); + is($out, '', 'RT #3605: $a ? my $var : my $othervar is perfectly valid syntax'); +} done_testing(); diff --git a/t/op/bless.t b/t/op/bless.t index 73c82ba..628677b 100644 --- a/t/op/bless.t +++ b/t/op/bless.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc('../lib'); } -plan (114); +plan (118); # Please do not eliminate the plan. We have tests in DESTROY blocks. sub expected { @@ -178,3 +178,59 @@ undef *Food::; is $w, undef, 'no warnings when reblessing inside DESTROY triggered by reblessing' } + +TODO: { + my $ref; + sub new { + my ($class, $code) = @_; + my $ret = ref($code); + bless $code => $class; + return $ret; + } + for my $i (1 .. 2) { + $ref = main -> new (sub {$i}); + } + is $ref, 'CODE', 'RT #3305: Code ref should not be blessed yet'; + + local $TODO = 'RT #3305'; + + for my $i (1 .. 2) { + $ref = main -> new (sub {}); + } + is $ref, 'CODE', 'RT #3305: Code ref should not be blessed yet'; +} + +my $t_3306_c = 0; +my $t_3306_s = 0; + +{ + sub FooClosure::new { + my ($class, $code) = @_; + bless $code => $class; + } + sub FooClosure::DESTROY { + $t_3306_c++; + } + + sub FooSub::new { + my ($class, $code) = @_; + bless $code => $class; + } + sub FooSub::DESTROY { + $t_3306_s++; + } + + my $i = ''; + FooClosure -> new (sub {$i}); + FooSub -> new (sub {}); +} + +is $t_3306_c, 1, 'RT #3306: DESTROY should be called on CODE ref (works on closures)'; + +TODO: { + local $TODO = 'RT #3306'; + is $t_3306_s, 1, 'RT #3306: DESTROY should be called on CODE ref'; +} + +undef *FooClosure::; +undef *FooSub::; diff --git a/t/op/blocks.t b/t/op/blocks.t index 262ebba..1673733 100644 --- a/t/op/blocks.t +++ b/t/op/blocks.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc('../lib'); } -plan tests => 7; +plan tests => 11; my @expect = qw( b1 @@ -145,3 +145,17 @@ expEct fresh_perl_is('END { print "ok\n" } INIT { bless {} and exit }', "ok\n", {}, 'null PL_curcop in newGP'); + +fresh_perl_is('BEGIN{exit 0}; print "still here"', '', {}, 'RT #2754: BEGIN{exit 0} should exit'); +TODO: { + local $TODO = 'RT #2754: CHECK{exit 0} is broken'; + fresh_perl_is('CHECK{exit 0}; print "still here"', '', {}, 'RT #2754: CHECK{exit 0} should exit'); +} + +TODO: { + local $TODO = 'RT #2917: INIT{} in eval is wrongly considered too late'; + fresh_perl_is('eval "INIT { print qq(in init); };";', 'in init', {}, 'RT #2917: No constraint on how late INIT blocks can run'); +} + +fresh_perl_is('eval "BEGIN {goto end}"; end:', '', {}, 'RT #113934: goto out of BEGIN causes assertion failure'); + diff --git a/t/op/caller.t b/t/op/caller.t index 969c3bd..3017465 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; set_up_inc('../lib'); - plan( tests => 96 ); # some tests are run in a BEGIN block + plan( tests => 97 ); # some tests are run in a BEGIN block } my @c; @@ -333,6 +333,22 @@ sub dbdie { END "caller should not SEGV for eval '' stack frames"; +TODO: { + local $::TODO = 'RT #7165: line number should be consistent for multiline subroutine calls'; + fresh_perl_is(<<'EOP', "6\n9\n", {}, 'RT #7165: line number should be consistent for multiline subroutine calls'); + sub tagCall { + my ($package, $file, $line) = caller; + print "$line\n"; + } + + tagCall + "abc"; + + tagCall + sub {}; +EOP +} + $::testing_caller = 1; do './op/caller.pl' or die $@; diff --git a/t/op/die.t b/t/op/die.t index 0833095..ef2b85f 100644 --- a/t/op/die.t +++ b/t/op/die.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc('../lib'); } -plan tests => 19; +plan tests => 20; eval { eval { @@ -95,3 +95,10 @@ like($@, qr/\.{3}propagated at/, '... and appends a phrase'); eval { undef $@; die }; is( $ok, 1, 'no warnings if $@ is undef' ); } + +TODO: { + local $TODO = 'RT #4821: die qr{x} does not check termination'; + my $out = runperl(prog => 'die qr{x}', stderr => 1); + like($out, qr/at -e line 1./, 'RT #4821: output from die qr{x}'); +} + diff --git a/t/op/for.t b/t/op/for.t index 053154c..a114180 100644 --- a/t/op/for.t +++ b/t/op/for.t @@ -548,20 +548,13 @@ for my $i (reverse (map {$_} @array, 1)) { } is ($r, '1CBA', 'Reverse for array and value via map with var'); -TODO: { - if (do {17; foreach (1, 2) { 1; } } != 17) { - #print "not "; - todo_skip("RT #1085: what should be output of perl -we 'print do { foreach (1, 2) { 1; } }'"); - } -} +is do {17; foreach (1, 2) { 1; } }, '', "RT #1085: what should be output of perl -we 'print do { foreach (1, 2) { 1; } }'"; TODO: { local $TODO = "RT #2166: foreach spuriously autovivifies"; my %h; foreach (@h{a, b}) {} - if(keys(%h)) { - todo_skip("RT #2166: foreach spuriously autovivifies"); - } + is keys(%h), 0, 'RT #2166: foreach spuriously autovivifies'; } sub { diff --git a/t/op/goto.t b/t/op/goto.t index 58780bb..6be6413 100644 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -10,7 +10,7 @@ BEGIN { use warnings; use strict; -plan tests => 98; +plan tests => 99; our $TODO; my $deprecated = 0; @@ -774,3 +774,30 @@ sub FETCH { $_[0][0] } tie my $t, "", sub { "cluck up porridge" }; is eval { sub { goto $t }->() }//$@, 'cluck up porridge', 'tied arg returning sub ref'; + +TODO: { + local $::TODO = 'RT #45091: goto in CORE::GLOBAL::exit unsupported'; + fresh_perl_is(<<'EOC', "before\ndie handler\n", {stderr => 1}, 'RT #45091: goto in CORE::GLOBAL::EXIT'); + BEGIN { + *CORE::GLOBAL::exit = sub { + goto FASTCGI_NEXT_REQUEST; + }; + } + while (1) { + eval { that_cgi_script() }; + FASTCGI_NEXT_REQUEST: + last; + } + + sub that_cgi_script { + local $SIG{__DIE__} = sub { print "die handler\n"; exit; print "exit failed?\n"; }; + print "before\n"; + eval { buggy_code() }; + print "after\n"; + } + sub buggy_code { + die "error!"; + print "after die\n"; + } +EOC +} diff --git a/t/op/local.t b/t/op/local.t index fa22126..e88798a 100644 --- a/t/op/local.t +++ b/t/op/local.t @@ -5,7 +5,7 @@ BEGIN { require './test.pl'; set_up_inc( qw(. ../lib) ); } -plan tests => 310; +plan tests => 315; my $list_assignment_supported = 1; @@ -469,8 +469,7 @@ is($h{'c'}, 3); # local() should preserve the existenceness of tied hash elements ok(! exists $h{'y'}); ok(! exists $h{'z'}); -TODO: { - todo_skip("Localize entire tied hash"); +{ my $d = join("\n", map { "$_=>$h{$_}" } sort keys %h); local %h = %h; is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d); @@ -825,3 +824,25 @@ local $SIG{__WARN__}; delete local @Grompits::{<foo bar>}; } pass 'rmagic does not cause delete local to crash on nonexistent elems'; + +TODO: { + my @a = (1..5); + { + local $#a = 2; + is($#a, 2, 'RT #7411: local($#a) should change count'); + is("@a", '1 2 3', 'RT #7411: local($#a) should shorten array'); + } + + local $::TODO = 'RT #7411: local($#a)'; + + is($#a, 4, 'RT #7411: after local($#a), count should be restored'); + is("@a", '1 2 3 4 5', 'RT #7411: after local($#a), array should be restored'); +} + +$a = 10; +TODO: { + local $::TODO = 'RT #7615: if (local $a)'; + if (local $a = 1){ + } + is($a, 10, 'RT #7615: local in if condition should be restored'); +} diff --git a/t/op/threads.t b/t/op/threads.t index 3a7c7ca..99e69bd 100644 --- a/t/op/threads.t +++ b/t/op/threads.t @@ -9,7 +9,7 @@ BEGIN { skip_all_without_config('useithreads'); skip_all_if_miniperl("no dynamic loading on miniperl, no threads"); - plan(28); + plan(30); } use strict; @@ -405,4 +405,22 @@ my @a = 1; threads->create(sub { $#a = 1; $a[1] = 2; print qq/ok\n/ })->join; CODE +fresh_perl_is(<<'CODE', '3.5,3.5', {}, 'RT #36664: Strange behavior of shared array'); +use threads; +use threads::shared; + +our @List : shared = (1..5); +my $v = 3.5; +$v > 0; +$List[3] = $v; +printf "%s,%s", @List[(3)], $List[3]; +CODE + +fresh_perl_like(<<'CODE', qr/ok/, {}, 'RT #41121 binmode(STDOUT,":encoding(utf8) does not crash'); +use threads; +binmode(STDOUT,":encoding(utf8)"); +threads->create(sub{}); +print "ok\n"; +CODE + # EOF diff --git a/t/re/pat.t b/t/re/pat.t index d0449e2..8a56227 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -23,7 +23,7 @@ BEGIN { skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader; skip_all_without_unicode_tables(); -plan tests => 799; # Update this when adding/deleting tests. +plan tests => 800; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1796,6 +1796,10 @@ EOP like("sS", qr/\N{}Ss|/i, "\N{} with empty branch alternation works"); } + TODO: { + local $::TODO = "RT #21491: m'' interpolates escape sequences"; + is(0+("\n" =~ m'\n'), 0, q|RT #21491: m'\n' should not interpolate|); + } } # End of sub run_tests 1; diff --git a/t/re/subst.t b/t/re/subst.t index d32e7b8..6224d64 100644 --- a/t/re/subst.t +++ b/t/re/subst.t @@ -11,7 +11,7 @@ BEGIN { require './loc_tools.pl'; } -plan( tests => 271 ); +plan( tests => 274 ); $_ = 'david'; $a = s/david/rules/r; @@ -1119,3 +1119,31 @@ SKIP: { {stderr => 1 }, '[perl #129038 ] s/\xff//l no longer crashes'); } + +{ + # RT #23624 scoping of @+/@- when used with tie() + #! /usr/bin/perl -w + + package Tie::Prematch; + sub TIEHASH { bless \my $dummy => __PACKAGE__ } + sub FETCH { return substr $_[1], 0, $-[0] } + + package main; + + tie my %pre, 'Tie::Prematch'; + my $foo = 'foobar'; + $foo =~ s/.ob/$pre{ $foo }/; + is($foo, 'ffar', 'RT #23624'); + + $foo = 'foobar'; + $foo =~ s/.ob/tied(%pre)->FETCH($foo)/e; + is($foo, 'ffar', 'RT #23624'); + + tie %-, 'Tie::Prematch'; + $foo = 'foobar'; + $foo =~ s/.ob/$-{$foo}/; + is($foo, 'ffar', 'RT #23624'); + + undef *Tie::Prematch::TIEHASH; + undef *Tie::Prematch::FETCH; +} diff --git a/t/uni/overload.t b/t/uni/overload.t index d7d541c..c534ecf 100644 --- a/t/uni/overload.t +++ b/t/uni/overload.t @@ -9,7 +9,7 @@ BEGIN { set_up_inc( '../lib' ); } -plan(tests => 215); +plan(tests => 217); package UTF8Toggle; use strict; @@ -287,3 +287,22 @@ foreach my $value ("\243", UTF8Toggle->new("\243")) { my $p = substr $text, 0, 1; is ($p, "\x{3075}"); } + +TODO: { + local $::TODO = 'RT #3054: Recursive operator overloading overflows the C stack'; + fresh_perl_is(<<'EOP', "ok\n", {}, 'RT #3054: Recursive operator overloading should not crash the interpreter'); + use overload '""' => sub { "$_[0]" }; + print bless {}, __PACKAGE__; + print "ok\n"; +EOP +} + +TODO: { + local $::TODO = 'RT #3270: Overloaded operators can not be treated as lvalues'; + fresh_perl_is(<<'EOP', '', {stderr => 1}, 'RT #3270: Overloaded operator that returns an lvalue can be used as an lvalue'); + use overload '.' => \˙ + sub dot : lvalue {my ($obj, $method) = @_; $obj -> {$method};} + my $o = bless {} => "main"; + $o.foo = "bar"; +EOP +} -- Perl5 Master Repository
