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