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