| 1 | BEGIN { |
| 2 | chdir 't'; |
| 3 | require './test.pl'; |
| 4 | set_up_inc("../lib"); |
| 5 | } |
| 6 | |
| 7 | plan 44; |
| 8 | |
| 9 | sub on { $::TODO = ' ' } |
| 10 | sub off{ $::TODO = '' } |
| 11 | |
| 12 | eval '\$x = \$y'; |
| 13 | like $@, qr/^Experimental lvalue references not enabled/, |
| 14 | 'error when feature is disabled'; |
| 15 | eval '\($x) = \$y'; |
| 16 | like $@, qr/^Experimental lvalue references not enabled/, |
| 17 | 'error when feature is disabled (aassign)'; |
| 18 | |
| 19 | use feature 'lvalue_refs'; |
| 20 | |
| 21 | { |
| 22 | my($w,$c); |
| 23 | local $SIG{__WARN__} = sub { $c++; $w = shift }; |
| 24 | eval '\$x = \$y'; |
| 25 | is $c, 1, 'one warning from lv ref assignment'; |
| 26 | like $w, qr/^Lvalue references are experimental/, |
| 27 | 'experimental warning'; |
| 28 | undef $c; |
| 29 | eval '\($x) = \$y'; |
| 30 | is $c, 1, 'one warning from lv ref list assignment'; |
| 31 | like $w, qr/^Lvalue references are experimental/, |
| 32 | 'experimental warning'; |
| 33 | } |
| 34 | |
| 35 | no warnings 'experimental::lvalue_refs'; |
| 36 | |
| 37 | # Scalars |
| 38 | |
| 39 | eval '\$x = \$y'; |
| 40 | is \$x, \$y, '\$pkg_scalar = ...'; |
| 41 | my $m; |
| 42 | \$m = \$y; |
| 43 | is \$m, \$y, '\$lexical = ...'; |
| 44 | \my $n = \$y; |
| 45 | is \$n, \$y, '\my $lexical = ...'; |
| 46 | @_ = \$_; |
| 47 | \($x) = @_; |
| 48 | is \$x, \$_, '\($pkgvar) = ... gives list context'; |
| 49 | undef *x; |
| 50 | (\$x) = @_; |
| 51 | is \$x, \$_, '(\$pkgvar) = ... gives list context'; |
| 52 | my $o; |
| 53 | \($o) = @_; |
| 54 | is \$o, \$_, '\($lexical) = ... gives list cx'; |
| 55 | my $q; |
| 56 | (\$q) = @_; |
| 57 | is \$q, \$_, '(\$lexical) = ... gives list cx'; |
| 58 | \(my $p) = @_; |
| 59 | is \$p, \$_, '\(my $lexical) = ... gives list cx'; |
| 60 | (\my $r) = @_; |
| 61 | is \$r, \$_, '(\my $lexical) = ... gives list cx'; |
| 62 | \my($s) = @_; |
| 63 | is \$s, \$_, '\my($lexical) = ... gives list cx'; |
| 64 | \($_a, my $a) = @{[\$b, \$c]}; |
| 65 | is \$_a, \$b, 'package scalar in \(...)'; |
| 66 | is \$a, \$c, 'lex scalar in \(...)'; |
| 67 | (\$_b, \my $b) = @{[\$b, \$c]}; |
| 68 | is \$_b, \$::b, 'package scalar in (\$foo, \$bar)'; |
| 69 | is \$b, \$c, 'lex scalar in (\$foo, \$bar)'; |
| 70 | is do { \local $l = \3; $l }, 3, '\local $scalar assignment'; |
| 71 | is $l, undef, 'localisation unwound'; |
| 72 | is do { \(local $l) = \4; $l }, 4, '\(local $scalar) assignment'; |
| 73 | is $l, undef, 'localisation unwound'; |
| 74 | \$foo = \*bar; |
| 75 | is *foo{SCALAR}, *bar{GLOB}, 'globref-to-scalarref assignment'; |
| 76 | on; |
| 77 | |
| 78 | # Array Elements |
| 79 | |
| 80 | # ... |
| 81 | |
| 82 | # Hash Elements |
| 83 | |
| 84 | # ... |
| 85 | |
| 86 | # Arrays |
| 87 | |
| 88 | # ... |
| 89 | |
| 90 | # Hashes |
| 91 | |
| 92 | # ... |
| 93 | |
| 94 | # Subroutines |
| 95 | |
| 96 | # ... |
| 97 | |
| 98 | # Mixed List Assignments |
| 99 | |
| 100 | off; |
| 101 | (\$tahi, $rua) = \(1,2); |
| 102 | is join(' ', $tahi, $$rua), '1 2', |
| 103 | 'mixed scalar ref and scalar list assignment'; |
| 104 | on; |
| 105 | |
| 106 | # Conditional expressions |
| 107 | |
| 108 | $_ = 3; |
| 109 | eval '$_ == 3 ? \$tahi : $rua = \3'; |
| 110 | is $tahi, 3, 'cond assignment resolving to scalar ref'; |
| 111 | eval '$_ == 3 ? \$toru : $wha = \3'; |
| 112 | is $$wha, 3, 'cond assignment resolving to scalar'; |
| 113 | eval '$_ == 3 ? \$rima : \$ono = \5'; |
| 114 | is $$rima, 5, 'cond assignment with refgens on both branches'; |
| 115 | |
| 116 | # Foreach |
| 117 | |
| 118 | eval ' |
| 119 | for \my $a(\$for1, \$for2) { |
| 120 | push @for, \$a; |
| 121 | } |
| 122 | '; |
| 123 | is "@for", \$for1 . ' ' . \$for2, 'foreach \my $a'; |
| 124 | |
| 125 | @for = (); |
| 126 | eval ' |
| 127 | for \my @a([1,2], [3,4]) { |
| 128 | push @for, @a; |
| 129 | } |
| 130 | '; |
| 131 | is "@for", "1 2 3 4", 'foreach \my @a [perl #22335]'; |
| 132 | |
| 133 | @for = (); |
| 134 | eval ' |
| 135 | for \my %a({5,6}, {7,8}) { |
| 136 | push @for, %a; |
| 137 | } |
| 138 | '; |
| 139 | is "@for", "5 6 7 8", 'foreach \my %a [perl #22335]'; |
| 140 | |
| 141 | @for = (); |
| 142 | eval ' |
| 143 | for \my &a(sub {9}, sub {10}) { |
| 144 | push @for, &a; |
| 145 | } |
| 146 | '; |
| 147 | is "@for", "9 10", 'foreach \my &a'; |
| 148 | |
| 149 | |
| 150 | # Errors |
| 151 | |
| 152 | off; |
| 153 | eval { my $x; \$x = 3 }; |
| 154 | like $@, qr/^Assigned value is not a reference at/, 'assigning non-ref'; |
| 155 | eval { my $x; \$x = [] }; |
| 156 | like $@, qr/^Assigned value is not a SCALAR reference at/, |
| 157 | 'assigning non-scalar ref to scalar ref'; |
| 158 | eval { \$::x = [] }; |
| 159 | like $@, qr/^Assigned value is not a SCALAR reference at/, |
| 160 | 'assigning non-scalar ref to package scalar ref'; |
| 161 | |
| 162 | on; |
| 163 | eval '(\do{}) = 42'; |
| 164 | like $@, qr/^Can't modify reference to do block in list assignment at /, |
| 165 | "Can't modify reference to do block in list assignment"; |
| 166 | off; |
| 167 | eval '(\pos) = 42'; |
| 168 | like $@, |
| 169 | qr/^Can't modify reference to match position in list assignment at /, |
| 170 | "Can't modify ref to some scalar-returning op in list assignment"; |
| 171 | eval '(\glob) = 42'; |
| 172 | like $@, |
| 173 | qr/^Can't modify reference to glob in list assignment at /, |
| 174 | "Can't modify reference to some list-returning op in list assignment"; |
| 175 | eval '\pos = 42'; |
| 176 | like $@, |
| 177 | qr/^Can't modify reference to match position in scalar assignment at /, |
| 178 | "Can't modify ref to some scalar-returning op in scalar assignment"; |
| 179 | on; |
| 180 | |
| 181 | # Miscellaneous |
| 182 | |
| 183 | { |
| 184 | my($x,$y); |
| 185 | sub { |
| 186 | sub { |
| 187 | \$x = \$y; |
| 188 | }->(); |
| 189 | is \$x, \$y, 'lexical alias affects outer closure'; |
| 190 | }->(); |
| 191 | is \$x, \$y, 'lexical alias affects outer sub where vars are declared'; |
| 192 | } |
| 193 | |
| 194 | { # PADSTALE has a double meaning |
| 195 | use feature 'lexical_subs', 'signatures', 'state'; |
| 196 | no warnings 'experimental'; |
| 197 | my $c; |
| 198 | my sub s ($arg) { |
| 199 | state $x = ++$c; |
| 200 | if ($arg == 3) { return $c } |
| 201 | goto skip if $arg == 2; |
| 202 | my $y; |
| 203 | skip: |
| 204 | # $y is PADSTALE the 2nd time |
| 205 | \$x = \$y if $arg == 2; |
| 206 | } |
| 207 | s(1); |
| 208 | s(2); |
| 209 | is s(3), 1, 'padstale alias should not reset state' |
| 210 | } |
| 211 | |
| 212 | off; |
| 213 | SKIP: { |
| 214 | skip_without_dynamic_extension('List/Util'); |
| 215 | require Scalar::Util; |
| 216 | my $a; |
| 217 | Scalar::Util::weaken($r = \$a); |
| 218 | \$a = $r; |
| 219 | pass 'no crash when assigning \$lex = $weakref_to_lex' |
| 220 | } |