disable optimization in change#3612 for join() and quotemeta()--this

[p5sagit/p5-mst-13.2.git] / t / op / lex_assign.t

diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t
old mode 100644 (file)
new mode 100755 (executable)
index d35f39c..56ddfff
--- a/t/op/lex_assign.t
+++ b/t/op/lex_assign.t
@@ -2,16 +2,18 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    unshift @INC, '../lib';
 }
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; 
 
 umask 0;
 $xref = \ "";
+$runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
 @a = (1..5);
 %h = (1..6);
 $aref = \@a;
 $href = \%h;
-open OP, qq{$^X -le 'print "aaa Ok ok" while \$i++ < 100'|};
+open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
 $chopit = 'aaaaaa';
 @chopar = (113 .. 119);
 $posstr = '123456';
@@ -21,11 +23,79 @@ $nn = $n = 2;
 sub subb {"in s"}
 
 @INPUT = <DATA>;
-print "1..", (scalar @INPUT), "\n";
+@simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
+print "1..", (9 + @INPUT + @simple_input), "\n";
 $ord = 0;
 
 sub wrn {"@_"}
 
+# Check correct optimization of ucfirst etc
+$ord++;
+my $a = "AB";
+my $b = "\u\L$a";
+print "not " unless $b eq 'Ab';
+print "ok $ord\n";
+
+# Check correct destruction of objects:
+my $dc = 0;
+sub A::DESTROY {$dc += 1}
+$a=8;
+my $b;
+{ my $c = 6; $b = bless \$c, "A"}
+
+$ord++;
+print "not " unless $dc == 0;
+print "ok $ord\n";
+
+$b = $a+5;
+
+$ord++;
+print "not " unless $dc == 1;
+print "ok $ord\n";
+
+$ord++;
+my $xxx = 'b';
+$xxx = 'c' . ($xxx || 'e');
+print "not " unless $xxx eq 'cb';
+print "ok $ord\n";
+
+{                              # Check calling STORE
+  my $sc = 0;
+  sub B::TIESCALAR {bless [11], 'B'}
+  sub B::FETCH { -(shift->[0]) }
+  sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
+
+  my $m;
+  tie $m, 'B';
+  $m = 100;
+
+  $ord++;
+  print "not " unless $sc == 1;
+  print "ok $ord\n";
+
+  my $t = 11;
+  $m = $t + 89;
+  
+  $ord++;
+  print "not " unless $sc == 2;
+  print "ok $ord\n";
+
+  $ord++;
+  print "# $m\nnot " unless $m == -117;
+  print "ok $ord\n";
+
+  $m += $t;
+
+  $ord++;
+  print "not " unless $sc == 3;
+  print "ok $ord\n";
+
+  $ord++;
+  print "# $m\nnot " unless $m == 89;
+  print "ok $ord\n";
+
+}
+
 for (@INPUT) {
   $ord++;
   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
@@ -33,7 +103,8 @@ for (@INPUT) {
   $op = "$op==$op" unless $op =~ /==/;
   ($op, $expectop) = $op =~ /(.*)==(.*)/;
   
-  $skip = ($op =~ /^'\?\?\?'/) ? "skip" : "not";
+  $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
+         ? "skip" : "not";
   $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
   (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
   
@@ -58,11 +129,38 @@ EOE
     }
   }
 }
+
+for (@simple_input) {
+  $ord++;
+  ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
+  $comment = $op unless defined $comment;
+  ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
+  eval <<EOE;
+  local \$SIG{__WARN__} = \\&wrn;
+  my \$$variable = "Ac# Ca\\nxxx";
+  \$$variable = $operator \$$variable;
+  \$toself = \$$variable;
+  \$direct = $operator "Ac# Ca\\nxxx";
+  print "# \\\$$variable = $operator \\\$$variable\\nnot "
+    unless \$toself eq \$direct;
+  print "ok \$ord\\n";
+EOE
+  if ($@) {
+    if ($@ =~ /is unimplemented/) {
+      print "# skipping $comment: unimplemented:\nok $ord\n";
+    } elsif ($@ =~ /Can't (modify|take log of 0)/) {
+      print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
+    } else {
+      warn $@;
+      print "not ok $ord\n";
+    }
+  }
+}
 __END__
 ref $xref                      # ref
 ref $cstr                      # ref nonref
-`ls`                           # backtick
-`$undefed`                     # backtick undef
+`$runme -e "print qq[1\n]"`                            # backtick skip(MSWin32)
+`$undefed`                     # backtick undef skip(MSWin32)
 <*>                            # glob
 <OP>                           # readline
 'faked'                                # rcatline
@@ -178,7 +276,7 @@ chmod 'non-existent'                # chmod
 utime 'non-existent'           # utime
 rename 'non-existent', 'non-existent1' # rename
 link 'non-existent', 'non-existent1' # link
-symlink 'non-existent', 'non-existent1' # symlink
+'???'                          # symlink
 readlink 'non-existent', 'non-existent1' # readlink
 '???'                          # mkdir
 '???'                          # rmdir
@@ -186,17 +284,17 @@ readlink 'non-existent', 'non-existent1' # readlink
 '???'                          # fork
 '???'                          # wait
 '???'                          # waitpid
-system 'sh -c true'            # system
+system "$runme -e 0"           # system skip(VMS)
 '???'                          # exec
-kill 0, $$                     # kill
+'???'                          # kill
 getppid                                # getppid
 getpgrp                                # getpgrp
 '???'                          # setpgrp
 getpriority $$, $$             # getpriority
 '???'                          # setpriority
 time                           # time
-localtime                      # localtime
-gmtime                         # gmtime
+localtime $^T                  # localtime
+gmtime $^T                     # gmtime
 sleep 1                                # sleep
 '???'                          # alarm
 '???'                          # shmget