t/op/flip.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require "./test.pl";
   6 }
   7
   8 plan(14);
   9
  10 @a = (1,2,3,4,5,6,7,8,9,10,11,12);
  11 @b = ();
  12 while ($_ = shift(@a)) {
  13     if ($x = /4/../8/) { $z = $x; push @b, $x + 0; }
  14     $y .= /1/../2/;
  15 }
  16 is(join("*", @b), "1*2*3*4*5");
  17
  18 is($z, '5E0');
  19
  20 is($y, '12E0123E0');
  21
  22 @a = ('a','b','c','d','e','f','g');
  23
  24 {
  25 local $.;
  26
  27 open(of,'harness') or die "Can't open harness: $!";
  28 while (<of>) {
  29     (3 .. 5) && ($foo .= $_);
  30 }
  31 $x = ($foo =~ y/\n/\n/);
  32
  33 is($x, 3);
  34
  35 $x = 3.14;
  36 ok(($x...$x) eq "1");
  37
  38 {
  39     # coredump reported in bug 20001018.008 (#4474)
  40     readline(UNKNOWN);
  41     $. = 1;
  42     $x = 1..10;
  43     ok(1);
  44 }
  45
  46 }
  47
  48 ok(!defined $.);
  49
  50 use warnings;
  51 my $warn='';
  52 $SIG{__WARN__} = sub { $warn .= join '', @_ };
  53
  54 ok(scalar(0..2));
  55
  56 like($warn, qr/uninitialized/);
  57 $warn = '';
  58
  59 $x = "foo".."bar";
  60
  61 ok((() = ($warn =~ /isn't numeric/g)) == 2);
  62 $warn = '';
  63
  64 $. = 15;
  65 ok(scalar(15..0));
  66
  67 push @_, \scalar(0..0) for 1,2;
  68 isnt $_[0], $_[1], '\scalar($a..$b) gives a different scalar each time';
  69
  70 # This evil little example from ticket #122829 abused the fact that each
  71 # recursion level maintained its own flip-flip state.  The following com-
  72 # ment describes how it *used* to work.
  73
  74 # This routine maintains multiple flip-flop states, each with its own
  75 # numeric ID, starting from 1.  Pass the ID as the argument.
  76 sub f {
  77     my $depth = shift() - 1;
  78     return f($depth) if $depth;
  79     return /3/../5/;
  80 }
  81 {
  82     my $accumulator;
  83     for(1..20) {
  84         if (f(1)) {
  85             my $outer = $_;
  86             for(1..10){
  87                 $accumulator .= "$outer $_\n" if f(2);
  88             }
  89         }
  90     }
  91     is $accumulator, <<EOT, 'recursion shares state';
  92 3 1
  93 3 2
  94 3 3
  95 3 4
  96 3 5
  97 13 1
  98 13 2
  99 13 3
 100 13 4
 101 13 5
 102 EOT
 103 }
 104
 105 # Void context gives parenthesized lhs scalar context
 106 no warnings 'void';
 107 sub c { $context = qw[ void scalar list ][wantarray + defined wantarray] }
 108 (c())x34;
 109 is $context, 'scalar', '(...)x... in void context';