| Line | |
|---|
| 1 | #!./perl
|
|---|
| 2 |
|
|---|
| 3 | BEGIN {
|
|---|
| 4 | chdir 't' if -d 't';
|
|---|
| 5 | @INC = '../lib';
|
|---|
| 6 | }
|
|---|
| 7 |
|
|---|
| 8 | require './test.pl';
|
|---|
| 9 | plan( tests => 14 );
|
|---|
| 10 |
|
|---|
| 11 | # test various operations on @_
|
|---|
| 12 |
|
|---|
| 13 | sub new1 { bless \@_ }
|
|---|
| 14 | {
|
|---|
| 15 | my $x = new1("x");
|
|---|
| 16 | my $y = new1("y");
|
|---|
| 17 | is("@$y","y");
|
|---|
| 18 | is("@$x","x");
|
|---|
| 19 | }
|
|---|
| 20 |
|
|---|
| 21 | sub new2 { splice @_, 0, 0, "a", "b", "c"; return \@_ }
|
|---|
| 22 | {
|
|---|
| 23 | my $x = new2("x");
|
|---|
| 24 | my $y = new2("y");
|
|---|
| 25 | is("@$x","a b c x");
|
|---|
| 26 | is("@$y","a b c y");
|
|---|
| 27 | }
|
|---|
| 28 |
|
|---|
| 29 | sub new3 { goto &new1 }
|
|---|
| 30 | {
|
|---|
| 31 | my $x = new3("x");
|
|---|
| 32 | my $y = new3("y");
|
|---|
| 33 | is("@$y","y");
|
|---|
| 34 | is("@$x","x");
|
|---|
| 35 | }
|
|---|
| 36 |
|
|---|
| 37 | sub new4 { goto &new2 }
|
|---|
| 38 | {
|
|---|
| 39 | my $x = new4("x");
|
|---|
| 40 | my $y = new4("y");
|
|---|
| 41 | is("@$x","a b c x");
|
|---|
| 42 | is("@$y","a b c y");
|
|---|
| 43 | }
|
|---|
| 44 |
|
|---|
| 45 | # see if POPSUB gets to see the right pad across a dounwind() with
|
|---|
| 46 | # a reified @_
|
|---|
| 47 |
|
|---|
| 48 | sub methimpl {
|
|---|
| 49 | my $refarg = \@_;
|
|---|
| 50 | die( "got: @_\n" );
|
|---|
| 51 | }
|
|---|
| 52 |
|
|---|
| 53 | sub method {
|
|---|
| 54 | &methimpl;
|
|---|
| 55 | }
|
|---|
| 56 |
|
|---|
| 57 | sub try {
|
|---|
| 58 | eval { method('foo', 'bar'); };
|
|---|
| 59 | print "# $@" if $@;
|
|---|
| 60 | }
|
|---|
| 61 |
|
|---|
| 62 | for (1..5) { try() }
|
|---|
| 63 | pass();
|
|---|
| 64 |
|
|---|
| 65 | # bug #21542 local $_[0] causes reify problems and coredumps
|
|---|
| 66 |
|
|---|
| 67 | sub local1 { local $_[0] }
|
|---|
| 68 | my $foo = 'foo'; local1($foo); local1($foo);
|
|---|
| 69 | print "got [$foo], expected [foo]\nnot " if $foo ne 'foo';
|
|---|
| 70 | pass();
|
|---|
| 71 |
|
|---|
| 72 | sub local2 { local $_[0]; last L }
|
|---|
| 73 | L: { local2 }
|
|---|
| 74 | pass();
|
|---|
| 75 |
|
|---|
| 76 | # blead has 9 tests for local(@_) from in t/op/nothr5005.t inserted here
|
|---|
| 77 |
|
|---|
| 78 | # [perl #28032] delete $_[0] was freeing things too early
|
|---|
| 79 |
|
|---|
| 80 | {
|
|---|
| 81 | my $flag = 0;
|
|---|
| 82 | sub X::DESTROY { $flag = 1 }
|
|---|
| 83 | sub f {
|
|---|
| 84 | delete $_[0];
|
|---|
| 85 | ok(!$flag, 'delete $_[0] : in f');
|
|---|
| 86 | }
|
|---|
| 87 | {
|
|---|
| 88 | my $x = bless [], 'X';
|
|---|
| 89 | f($x);
|
|---|
| 90 | ok(!$flag, 'delete $_[0] : after f');
|
|---|
| 91 | }
|
|---|
| 92 | ok($flag, 'delete $_[0] : outside block');
|
|---|
| 93 | }
|
|---|
| 94 |
|
|---|
| 95 |
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.