This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[patch] blead@25282 - VMS specific fixes. [2nd try]
[perl5.git] / t / op / lex_assign.t
index 0f65869..c6c424d 100755 (executable)
@@ -2,13 +2,13 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
-$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; 
 
+$| = 1;
 umask 0;
 $xref = \ "";
-$runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
+$runme = $^X;
 @a = (1..5);
 %h = (1..6);
 $aref = \@a;
@@ -24,7 +24,7 @@ sub subb {"in s"}
 
 @INPUT = <DATA>;
 @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
-print "1..", (8 + @INPUT + @simple_input), "\n";
+print "1..", (10 + @INPUT + @simple_input), "\n";
 $ord = 0;
 
 sub wrn {"@_"}
@@ -53,6 +53,12 @@ $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'}
@@ -90,15 +96,28 @@ print "ok $ord\n";
 
 }
 
+# Chains of assignments
+
+my ($l1, $l2, $l3, $l4);
+my $zzzz = 12;
+$zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz;
+
+$ord++;
+print "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot "
+  unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13
+  and $l2 == 13 and $l3 == 13 and $l4 == 13;
+print "ok $ord\n";
+
 for (@INPUT) {
   $ord++;
   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
   $comment = $op unless defined $comment;
+  chomp;
   $op = "$op==$op" unless $op =~ /==/;
   ($op, $expectop) = $op =~ /(.*)==(.*)/;
   
   $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
-         ? "skip" : "not";
+         ? "skip" : "# '$_'\nnot";
   $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
   (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
   
@@ -119,7 +138,7 @@ EOE
       print "# skipping $comment: unimplemented:\nok $ord\n";
     } else {
       warn $@;
-      print "not ok $ord\n";
+      print "# '$_'\nnot ok $ord\n";
     }
   }
 }
@@ -128,6 +147,7 @@ for (@simple_input) {
   $ord++;
   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
   $comment = $op unless defined $comment;
+  chomp;
   ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
   eval <<EOE;
   local \$SIG{__WARN__} = \\&wrn;
@@ -146,14 +166,14 @@ EOE
       print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
     } else {
       warn $@;
-      print "not ok $ord\n";
+      print "# '$_'\nnot ok $ord\n";
     }
   }
 }
 __END__
 ref $xref                      # ref
 ref $cstr                      # ref nonref
-`$runme -e "print qq[1\n]"`                            # backtick skip(MSWin32)
+`$runme -e "print qq[1\\n]"`                           # backtick skip(MSWin32)
 `$undefed`                     # backtick undef skip(MSWin32)
 <*>                            # glob
 <OP>                           # readline
@@ -224,7 +244,7 @@ lc $cstr                    # lc
 quotemeta $cstr                        # quotemeta
 @$aref                         # rv2av
 @$undefed                      # rv2av undef
-each %h==1                     # each
+(each %h) % 2 == 1             # each
 values %h                      # values
 keys %h                                # keys
 %$href                         # rv2hv
@@ -245,7 +265,7 @@ open BLAH, "<non-existent"  # open
 fileno STDERR                  # fileno
 umask 0                                # umask
 select STDOUT                  # sselect
-select "","","",0              # select
+select undef,undef,undef,0     # select
 getc OP                                # getc
 '???'                          # read
 '???'                          # sysread
@@ -289,7 +309,7 @@ getpriority $$, $$          # getpriority
 time                           # time
 localtime $^T                  # localtime
 gmtime $^T                     # gmtime
-sleep 1                                # sleep
+'???'                          # sleep: can randomly fail
 '???'                          # alarm
 '???'                          # shmget
 '???'                          # shmctl