This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
change#3612 is buggy when quotemeta argument matches target
[perl5.git] / t / op / lex_assign.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     unshift @INC, '../lib';
6 }
7
8 umask 0;
9 $xref = \ "";
10 $runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
11 @a = (1..5);
12 %h = (1..6);
13 $aref = \@a;
14 $href = \%h;
15 open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
16 $chopit = 'aaaaaa';
17 @chopar = (113 .. 119);
18 $posstr = '123456';
19 $cstr = 'aBcD.eF';
20 pos $posstr = 3;
21 $nn = $n = 2;
22 sub subb {"in s"}
23
24 @INPUT = <DATA>;
25 @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
26 print "1..", (8 + @INPUT + @simple_input), "\n";
27 $ord = 0;
28
29 sub wrn {"@_"}
30
31 # Check correct optimization of ucfirst etc
32 $ord++;
33 my $a = "AB";
34 my $b = "\u\L$a";
35 print "not " unless $b eq 'Ab';
36 print "ok $ord\n";
37
38 # Check correct destruction of objects:
39 my $dc = 0;
40 sub A::DESTROY {$dc += 1}
41 $a=8;
42 my $b;
43 { my $c = 6; $b = bless \$c, "A"}
44
45 $ord++;
46 print "not " unless $dc == 0;
47 print "ok $ord\n";
48
49 $b = $a+5;
50
51 $ord++;
52 print "not " unless $dc == 1;
53 print "ok $ord\n";
54
55 {                               # Check calling STORE
56   my $sc = 0;
57   sub B::TIESCALAR {bless [11], 'B'}
58   sub B::FETCH { -(shift->[0]) }
59   sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
60
61   my $m;
62   tie $m, 'B';
63   $m = 100;
64
65   $ord++;
66   print "not " unless $sc == 1;
67   print "ok $ord\n";
68
69   my $t = 11;
70   $m = $t + 89;
71   
72   $ord++;
73   print "not " unless $sc == 2;
74   print "ok $ord\n";
75
76   $ord++;
77   print "# $m\nnot " unless $m == -117;
78   print "ok $ord\n";
79
80   $m += $t;
81
82   $ord++;
83   print "not " unless $sc == 3;
84   print "ok $ord\n";
85
86   $ord++;
87   print "# $m\nnot " unless $m == 89;
88   print "ok $ord\n";
89
90 }
91
92 for (@INPUT) {
93   $ord++;
94   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
95   $comment = $op unless defined $comment;
96   $op = "$op==$op" unless $op =~ /==/;
97   ($op, $expectop) = $op =~ /(.*)==(.*)/;
98   
99   $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
100           ? "skip" : "not";
101   $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
102   (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
103   
104   eval <<EOE;
105   local \$SIG{__WARN__} = \\&wrn;
106   my \$a = 'fake';
107   $integer;
108   \$a = $op;
109   \$b = $expectop;
110   if (\$a ne \$b) {
111     print "# \$comment: got `\$a', expected `\$b'\n";
112     print "\$skip " if \$a ne \$b or \$skip eq 'skip';
113   }
114   print "ok \$ord\\n";
115 EOE
116   if ($@) {
117     if ($@ =~ /is unimplemented/) {
118       print "# skipping $comment: unimplemented:\nok $ord\n";
119     } else {
120       warn $@;
121       print "not ok $ord\n";
122     }
123   }
124 }
125
126 for (@simple_input) {
127   $ord++;
128   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
129   $comment = $op unless defined $comment;
130   ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
131   eval <<EOE;
132   local \$SIG{__WARN__} = \\&wrn;
133   my \$$variable = "Ac# Ca\\nxxx";
134   \$$variable = $operator \$$variable;
135   \$toself = \$$variable;
136   \$direct = $operator "Ac# Ca\\nxxx";
137   print "# \\\$$variable = $operator \\\$$variable\\nnot "
138     unless \$toself eq \$direct;
139   print "ok \$ord\\n";
140 EOE
141   if ($@) {
142     if ($@ =~ /is unimplemented/) {
143       print "# skipping $comment: unimplemented:\nok $ord\n";
144     } elsif ($@ =~ /Can't (modify|take log of 0)/) {
145       print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
146     } else {
147       warn $@;
148       print "not ok $ord\n";
149     }
150   }
151 }
152 __END__
153 ref $xref                       # ref
154 ref $cstr                       # ref nonref
155 `$runme -e "print qq[1\n]"`                             # backtick skip(MSWin32)
156 `$undefed`                      # backtick undef skip(MSWin32)
157 <*>                             # glob
158 <OP>                            # readline
159 'faked'                         # rcatline
160 (@z = (1 .. 3))                 # aassign
161 chop $chopit                    # chop
162 (chop (@x=@chopar))             # schop
163 chomp $chopit                   # chomp
164 (chop (@x=@chopar))             # schomp
165 pos $posstr                     # pos
166 pos $chopit                     # pos returns undef
167 $nn++==2                        # postinc
168 $nn++==3                        # i_postinc
169 $nn--==4                        # postdec
170 $nn--==3                        # i_postdec
171 $n ** $n                        # pow
172 $n * $n                         # multiply
173 $n * $n                         # i_multiply
174 $n / $n                         # divide
175 $n / $n                         # i_divide
176 $n % $n                         # modulo
177 $n % $n                         # i_modulo
178 $n x $n                         # repeat
179 $n + $n                         # add
180 $n + $n                         # i_add
181 $n - $n                         # subtract
182 $n - $n                         # i_subtract
183 $n . $n                         # concat
184 $n . $a=='2fake'                # concat with self
185 "3$a"=='3fake'                  # concat with self in stringify
186 "$n"                            # stringify
187 $n << $n                        # left_shift
188 $n >> $n                        # right_shift
189 $n <=> $n                       # ncmp
190 $n <=> $n                       # i_ncmp
191 $n cmp $n                       # scmp
192 $n & $n                         # bit_and
193 $n ^ $n                         # bit_xor
194 $n | $n                         # bit_or
195 -$n                             # negate
196 -$n                             # i_negate
197 ~$n                             # complement
198 atan2 $n,$n                     # atan2
199 sin $n                          # sin
200 cos $n                          # cos
201 '???'                           # rand
202 exp $n                          # exp
203 log $n                          # log
204 sqrt $n                         # sqrt
205 int $n                          # int
206 hex $n                          # hex
207 oct $n                          # oct
208 abs $n                          # abs
209 length $posstr                  # length
210 substr $posstr, 2, 2            # substr
211 vec("abc",2,8)                  # vec
212 index $posstr, 2                # index
213 rindex $posstr, 2               # rindex
214 sprintf "%i%i", $n, $n          # sprintf
215 ord $n                          # ord
216 chr $n                          # chr
217 crypt $n, $n                    # crypt
218 ucfirst ($cstr . "a")           # ucfirst padtmp
219 ucfirst $cstr                   # ucfirst
220 lcfirst $cstr                   # lcfirst
221 uc $cstr                        # uc
222 lc $cstr                        # lc
223 quotemeta $cstr                 # quotemeta
224 @$aref                          # rv2av
225 @$undefed                       # rv2av undef
226 each %h==1                      # each
227 values %h                       # values
228 keys %h                         # keys
229 %$href                          # rv2hv
230 pack "C2", $n,$n                # pack
231 split /a/, "abad"               # split
232 join "a"; @a                    # join
233 push @a,3==6                    # push
234 unshift @aaa                    # unshift
235 reverse @a                      # reverse
236 reverse $cstr                   # reverse - scal
237 grep $_, 1,0,2,0,3              # grepwhile
238 map "x$_", 1,0,2,0,3            # mapwhile
239 subb()                          # entersub
240 caller                          # caller
241 warn "ignore this\n"            # warn
242 'faked'                         # die
243 open BLAH, "<non-existent"      # open
244 fileno STDERR                   # fileno
245 umask 0                         # umask
246 select STDOUT                   # sselect
247 select "","","",0               # select
248 getc OP                         # getc
249 '???'                           # read
250 '???'                           # sysread
251 '???'                           # syswrite
252 '???'                           # send
253 '???'                           # recv
254 '???'                           # tell
255 '???'                           # fcntl
256 '???'                           # ioctl
257 '???'                           # flock
258 '???'                           # accept
259 '???'                           # shutdown
260 '???'                           # ftsize
261 '???'                           # ftmtime
262 '???'                           # ftatime
263 '???'                           # ftctime
264 chdir 'non-existent'            # chdir
265 '???'                           # chown
266 '???'                           # chroot
267 unlink 'non-existent'           # unlink
268 chmod 'non-existent'            # chmod
269 utime 'non-existent'            # utime
270 rename 'non-existent', 'non-existent1'  # rename
271 link 'non-existent', 'non-existent1' # link
272 '???'                           # symlink
273 readlink 'non-existent', 'non-existent1' # readlink
274 '???'                           # mkdir
275 '???'                           # rmdir
276 '???'                           # telldir
277 '???'                           # fork
278 '???'                           # wait
279 '???'                           # waitpid
280 system "$runme -e 0"            # system skip(VMS)
281 '???'                           # exec
282 '???'                           # kill
283 getppid                         # getppid
284 getpgrp                         # getpgrp
285 '???'                           # setpgrp
286 getpriority $$, $$              # getpriority
287 '???'                           # setpriority
288 time                            # time
289 localtime $^T                   # localtime
290 gmtime $^T                      # gmtime
291 sleep 1                         # sleep
292 '???'                           # alarm
293 '???'                           # shmget
294 '???'                           # shmctl
295 '???'                           # shmread
296 '???'                           # shmwrite
297 '???'                           # msgget
298 '???'                           # msgctl
299 '???'                           # msgsnd
300 '???'                           # msgrcv
301 '???'                           # semget
302 '???'                           # semctl
303 '???'                           # semop
304 '???'                           # getlogin
305 '???'                           # syscall