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..", (11 + @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
 174 $ord++;
 175 eval {
 176     sub PVBM () { 'foo' }
 177     index 'foo', PVBM;
 178     my $x = PVBM;
 179
 180     my $str = 'foo';
 181     my $pvlv = \substr $str, 0, 1;
 182     $x = $pvlv;
 183
 184     1;
 185 };
 186 if ($@) {
 187     warn "# $@";
 188     print 'not ';
 189 }
 190 print "ok $ord\n";
 191
 192 __END__
 193 ref $xref                       # ref
 194 ref $cstr                       # ref nonref
 195 `$runme -e "print qq[1\\n]"`                            # backtick skip(MSWin32)
 196 `$undefed`                      # backtick undef skip(MSWin32)
 197 <*>                             # glob
 198 <OP>                            # readline
 199 'faked'                         # rcatline
 200 (@z = (1 .. 3))                 # aassign
 201 chop $chopit                    # chop
 202 (chop (@x=@chopar))             # schop
 203 chomp $chopit                   # chomp
 204 (chop (@x=@chopar))             # schomp
 205 pos $posstr                     # pos
 206 pos $chopit                     # pos returns undef
 207 $nn++==2                        # postinc
 208 $nn++==3                        # i_postinc
 209 $nn--==4                        # postdec
 210 $nn--==3                        # i_postdec
 211 $n ** $n                        # pow
 212 $n * $n                         # multiply
 213 $n * $n                         # i_multiply
 214 $n / $n                         # divide
 215 $n / $n                         # i_divide
 216 $n % $n                         # modulo
 217 $n % $n                         # i_modulo
 218 $n x $n                         # repeat
 219 $n + $n                         # add
 220 $n + $n                         # i_add
 221 $n - $n                         # subtract
 222 $n - $n                         # i_subtract
 223 $n . $n                         # concat
 224 $n . $a=='2fake'                # concat with self
 225 "3$a"=='3fake'                  # concat with self in stringify
 226 "$n"                            # stringify
 227 $n << $n                        # left_shift
 228 $n >> $n                        # right_shift
 229 $n <=> $n                       # ncmp
 230 $n <=> $n                       # i_ncmp
 231 $n cmp $n                       # scmp
 232 $n & $n                         # bit_and
 233 $n ^ $n                         # bit_xor
 234 $n | $n                         # bit_or
 235 -$n                             # negate
 236 -$n                             # i_negate
 237 ~$n                             # complement
 238 atan2 $n,$n                     # atan2
 239 sin $n                          # sin
 240 cos $n                          # cos
 241 '???'                           # rand
 242 exp $n                          # exp
 243 log $n                          # log
 244 sqrt $n                         # sqrt
 245 int $n                          # int
 246 hex $n                          # hex
 247 oct $n                          # oct
 248 abs $n                          # abs
 249 length $posstr                  # length
 250 substr $posstr, 2, 2            # substr
 251 vec("abc",2,8)                  # vec
 252 index $posstr, 2                # index
 253 rindex $posstr, 2               # rindex
 254 sprintf "%i%i", $n, $n          # sprintf
 255 ord $n                          # ord
 256 chr $n                          # chr
 257 crypt $n, $n                    # crypt
 258 ucfirst ($cstr . "a")           # ucfirst padtmp
 259 ucfirst $cstr                   # ucfirst
 260 lcfirst $cstr                   # lcfirst
 261 uc $cstr                        # uc
 262 lc $cstr                        # lc
 263 quotemeta $cstr                 # quotemeta
 264 @$aref                          # rv2av
 265 @$undefed                       # rv2av undef
 266 (each %h) % 2 == 1              # each
 267 values %h                       # values
 268 keys %h                         # keys
 269 %$href                          # rv2hv
 270 pack "C2", $n,$n                # pack
 271 split /a/, "abad"               # split
 272 join "a"; @a                    # join
 273 push @a,3==6                    # push
 274 unshift @aaa                    # unshift
 275 reverse @a                      # reverse
 276 reverse $cstr                   # reverse - scal
 277 grep $_, 1,0,2,0,3              # grepwhile
 278 map "x$_", 1,0,2,0,3            # mapwhile
 279 subb()                          # entersub
 280 caller                          # caller
 281 warn "ignore this\n"            # warn
 282 'faked'                         # die
 283 open BLAH, "<non-existent"      # open
 284 fileno STDERR                   # fileno
 285 umask 0                         # umask
 286 select STDOUT                   # sselect
 287 select undef,undef,undef,0      # select
 288 getc OP                         # getc
 289 '???'                           # read
 290 '???'                           # sysread
 291 '???'                           # syswrite
 292 '???'                           # send
 293 '???'                           # recv
 294 '???'                           # tell
 295 '???'                           # fcntl
 296 '???'                           # ioctl
 297 '???'                           # flock
 298 '???'                           # accept
 299 '???'                           # shutdown
 300 '???'                           # ftsize
 301 '???'                           # ftmtime
 302 '???'                           # ftatime
 303 '???'                           # ftctime
 304 chdir 'non-existent'            # chdir
 305 '???'                           # chown
 306 '???'                           # chroot
 307 unlink 'non-existent'           # unlink
 308 chmod 'non-existent'            # chmod
 309 utime 'non-existent'            # utime
 310 rename 'non-existent', 'non-existent1'  # rename
 311 link 'non-existent', 'non-existent1' # link
 312 '???'                           # symlink
 313 readlink 'non-existent', 'non-existent1' # readlink
 314 '???'                           # mkdir
 315 '???'                           # rmdir
 316 '???'                           # telldir
 317 '???'                           # fork
 318 '???'                           # wait
 319 '???'                           # waitpid
 320 system "$runme -e 0"            # system skip(VMS)
 321 '???'                           # exec
 322 '???'                           # kill
 323 getppid                         # getppid
 324 getpgrp                         # getpgrp
 325 '???'                           # setpgrp
 326 getpriority $$, $$              # getpriority
 327 '???'                           # setpriority
 328 time                            # time
 329 localtime $^T                   # localtime
 330 gmtime $^T                      # gmtime
 331 '???'                           # sleep: can randomly fail
 332 '???'                           # alarm
 333 '???'                           # shmget
 334 '???'                           # shmctl
 335 '???'                           # shmread
 336 '???'                           # shmwrite
 337 '???'                           # msgget
 338 '???'                           # msgctl
 339 '???'                           # msgsnd
 340 '???'                           # msgrcv
 341 '???'                           # semget
 342 '???'                           # semctl
 343 '???'                           # semop
 344 '???'                           # getlogin
 345 '???'                           # syscall