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