[patch] blead@25282 - VMS specific fixes. [2nd try]
[perl.git] / t / op / lex_assign.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 $| = 1;
9 umask 0;
10 $xref = \ "";
11 $runme = $^X;
12 @a = (1..5);
13 %h = (1..6);
14 $aref = \@a;
15 $href = \%h;
16 open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
17 $chopit = 'aaaaaa';
18 @chopar = (113 .. 119);
19 $posstr = '123456';
20 $cstr = 'aBcD.eF';
21 pos $posstr = 3;
22 $nn = $n = 2;
23 sub subb {"in s"}
24
25 @INPUT = <DATA>;
26 @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
27 print "1..", (10 + @INPUT + @simple_input), "\n";
28 $ord = 0;
29
30 sub wrn {"@_"}
31
32 # Check correct optimization of ucfirst etc
33 $ord++;
34 my $a = "AB";
35 my $b = "\u\L$a";
36 print "not " unless $b eq 'Ab';
37 print "ok $ord\n";
38
39 # Check correct destruction of objects:
40 my $dc = 0;
41 sub A::DESTROY {$dc += 1}
42 $a=8;
43 my $b;
44 { my $c = 6; $b = bless \$c, "A"}
45
46 $ord++;
47 print "not " unless $dc == 0;
48 print "ok $ord\n";
49
50 $b = $a+5;
51
52 $ord++;
53 print "not " unless $dc == 1;
54 print "ok $ord\n";
55
56 $ord++;
57 my $xxx = 'b';
58 $xxx = 'c' . ($xxx || 'e');
59 print "not " unless $xxx eq 'cb';
60 print "ok $ord\n";
61
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
99 # Chains of assignments
100
101 my ($l1, $l2, $l3, $l4);
102 my $zzzz = 12;
103 $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz;
104
105 $ord++;
106 print "# $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;
109 print "ok $ord\n";
110
111 for (@INPUT) {
112   $ord++;
113   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
114   $comment = $op unless defined $comment;
115   chomp;
116   $op = "$op==$op" unless $op =~ /==/;
117   ($op, $expectop) = $op =~ /(.*)==(.*)/;
118   
119   $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
120           ? "skip" : "# '$_'\nnot";
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";
135 EOE
136   if ($@) {
137     if ($@ =~ /is unimplemented/) {
138       print "# skipping $comment: unimplemented:\nok $ord\n";
139     } else {
140       warn $@;
141       print "# '$_'\nnot ok $ord\n";
142     }
143   }
144 }
145
146 for (@simple_input) {
147   $ord++;
148   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
149   $comment = $op unless defined $comment;
150   chomp;
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";
161 EOE
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 $@;
169       print "# '$_'\nnot ok $ord\n";
170     }
171   }
172 }
173 __END__
174 ref $xref                       # ref
175 ref $cstr                       # ref nonref
176 `$runme -e "print qq[1\\n]"`                            # backtick skip(MSWin32)
177 `$undefed`                      # backtick undef skip(MSWin32)
178 <*>                             # glob
179 <OP>                            # readline
180 'faked'                         # rcatline
181 (@z = (1 .. 3))                 # aassign
182 chop $chopit                    # chop
183 (chop (@x=@chopar))             # schop
184 chomp $chopit                   # chomp
185 (chop (@x=@chopar))             # schomp
186 pos $posstr                     # pos
187 pos $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
219 atan2 $n,$n                     # atan2
220 sin $n                          # sin
221 cos $n                          # cos
222 '???'                           # rand
223 exp $n                          # exp
224 log $n                          # log
225 sqrt $n                         # sqrt
226 int $n                          # int
227 hex $n                          # hex
228 oct $n                          # oct
229 abs $n                          # abs
230 length $posstr                  # length
231 substr $posstr, 2, 2            # substr
232 vec("abc",2,8)                  # vec
233 index $posstr, 2                # index
234 rindex $posstr, 2               # rindex
235 sprintf "%i%i", $n, $n          # sprintf
236 ord $n                          # ord
237 chr $n                          # chr
238 crypt $n, $n                    # crypt
239 ucfirst ($cstr . "a")           # ucfirst padtmp
240 ucfirst $cstr                   # ucfirst
241 lcfirst $cstr                   # lcfirst
242 uc $cstr                        # uc
243 lc $cstr                        # lc
244 quotemeta $cstr                 # quotemeta
245 @$aref                          # rv2av
246 @$undefed                       # rv2av undef
247 (each %h) % 2 == 1              # each
248 values %h                       # values
249 keys %h                         # keys
250 %$href                          # rv2hv
251 pack "C2", $n,$n                # pack
252 split /a/, "abad"               # split
253 join "a"; @a                    # join
254 push @a,3==6                    # push
255 unshift @aaa                    # unshift
256 reverse @a                      # reverse
257 reverse $cstr                   # reverse - scal
258 grep $_, 1,0,2,0,3              # grepwhile
259 map "x$_", 1,0,2,0,3            # mapwhile
260 subb()                          # entersub
261 caller                          # caller
262 warn "ignore this\n"            # warn
263 'faked'                         # die
264 open BLAH, "<non-existent"      # open
265 fileno STDERR                   # fileno
266 umask 0                         # umask
267 select STDOUT                   # sselect
268 select undef,undef,undef,0      # select
269 getc 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
285 chdir 'non-existent'            # chdir
286 '???'                           # chown
287 '???'                           # chroot
288 unlink 'non-existent'           # unlink
289 chmod 'non-existent'            # chmod
290 utime 'non-existent'            # utime
291 rename 'non-existent', 'non-existent1'  # rename
292 link 'non-existent', 'non-existent1' # link
293 '???'                           # symlink
294 readlink 'non-existent', 'non-existent1' # readlink
295 '???'                           # mkdir
296 '???'                           # rmdir
297 '???'                           # telldir
298 '???'                           # fork
299 '???'                           # wait
300 '???'                           # waitpid
301 system "$runme -e 0"            # system skip(VMS)
302 '???'                           # exec
303 '???'                           # kill
304 getppid                         # getppid
305 getpgrp                         # getpgrp
306 '???'                           # setpgrp
307 getpriority $$, $$              # getpriority
308 '???'                           # setpriority
309 time                            # time
310 localtime $^T                   # localtime
311 gmtime $^T                      # gmtime
312 '???'                           # sleep: can randomly fail
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