Devel::PPPort: Fix D_PPP_FIX_UTF8_ERRSV macro
[perl.git] / 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';