t/op/lex_assign.t

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