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
CommitLineData
317982ac
IZ
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
93430cb4 5 unshift @INC, '../lib';
317982ac
IZ
6}
7
8umask 0;
9$xref = \ "";
562a7b0c 10$runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
317982ac
IZ
11@a = (1..5);
12%h = (1..6);
13$aref = \@a;
14$href = \%h;
562a7b0c 15open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
317982ac
IZ
16$chopit = 'aaaaaa';
17@chopar = (113 .. 119);
18$posstr = '123456';
19$cstr = 'aBcD.eF';
20pos $posstr = 3;
21$nn = $n = 2;
22sub subb {"in s"}
23
24@INPUT = <DATA>;
3dbf192b
IZ
25@simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
26print "1..", (8 + @INPUT + @simple_input), "\n";
317982ac
IZ
27$ord = 0;
28
29sub wrn {"@_"}
30
ed7ab888
GS
31# Check correct optimization of ucfirst etc
32$ord++;
33my $a = "AB";
34my $b = "\u\L$a";
35print "not " unless $b eq 'Ab';
36print "ok $ord\n";
37
38# Check correct destruction of objects:
39my $dc = 0;
40sub A::DESTROY {$dc += 1}
41$a=8;
42my $b;
43{ my $c = 6; $b = bless \$c, "A"}
44
45$ord++;
46print "not " unless $dc == 0;
47print "ok $ord\n";
48
49$b = $a+5;
50
51$ord++;
52print "not " unless $dc == 1;
53print "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
317982ac
IZ
92for (@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
0f4592ef
GS
99 $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
100 ? "skip" : "not";
317982ac
IZ
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";
115EOE
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}
3dbf192b
IZ
125
126for (@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";
140EOE
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}
317982ac
IZ
152__END__
153ref $xref # ref
154ref $cstr # ref nonref
562a7b0c 155`$runme -e "print qq[1\n]"` # backtick skip(MSWin32)
0f4592ef 156`$undefed` # backtick undef skip(MSWin32)
317982ac
IZ
157<*> # glob
158<OP> # readline
159'faked' # rcatline
160(@z = (1 .. 3)) # aassign
161chop $chopit # chop
162(chop (@x=@chopar)) # schop
163chomp $chopit # chomp
164(chop (@x=@chopar)) # schomp
165pos $posstr # pos
166pos $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
198atan2 $n,$n # atan2
199sin $n # sin
200cos $n # cos
201'???' # rand
202exp $n # exp
203log $n # log
204sqrt $n # sqrt
205int $n # int
206hex $n # hex
207oct $n # oct
208abs $n # abs
209length $posstr # length
210substr $posstr, 2, 2 # substr
211vec("abc",2,8) # vec
212index $posstr, 2 # index
213rindex $posstr, 2 # rindex
214sprintf "%i%i", $n, $n # sprintf
215ord $n # ord
216chr $n # chr
217crypt $n, $n # crypt
218ucfirst ($cstr . "a") # ucfirst padtmp
219ucfirst $cstr # ucfirst
220lcfirst $cstr # lcfirst
221uc $cstr # uc
222lc $cstr # lc
223quotemeta $cstr # quotemeta
224@$aref # rv2av
225@$undefed # rv2av undef
226each %h==1 # each
227values %h # values
228keys %h # keys
229%$href # rv2hv
230pack "C2", $n,$n # pack
231split /a/, "abad" # split
232join "a"; @a # join
233push @a,3==6 # push
234unshift @aaa # unshift
235reverse @a # reverse
236reverse $cstr # reverse - scal
237grep $_, 1,0,2,0,3 # grepwhile
238map "x$_", 1,0,2,0,3 # mapwhile
239subb() # entersub
240caller # caller
241warn "ignore this\n" # warn
242'faked' # die
243open BLAH, "<non-existent" # open
244fileno STDERR # fileno
245umask 0 # umask
246select STDOUT # sselect
247select "","","",0 # select
248getc 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
264chdir 'non-existent' # chdir
265'???' # chown
266'???' # chroot
267unlink 'non-existent' # unlink
268chmod 'non-existent' # chmod
269utime 'non-existent' # utime
270rename 'non-existent', 'non-existent1' # rename
271link 'non-existent', 'non-existent1' # link
ecece5d6 272'???' # symlink
317982ac
IZ
273readlink 'non-existent', 'non-existent1' # readlink
274'???' # mkdir
275'???' # rmdir
276'???' # telldir
277'???' # fork
278'???' # wait
279'???' # waitpid
562a7b0c 280system "$runme -e 0" # system skip(VMS)
317982ac 281'???' # exec
0f4592ef 282'???' # kill
317982ac
IZ
283getppid # getppid
284getpgrp # getpgrp
285'???' # setpgrp
286getpriority $$, $$ # getpriority
287'???' # setpriority
288time # time
7e3cfbc1
MG
289localtime $^T # localtime
290gmtime $^T # gmtime
317982ac
IZ
291sleep 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