This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Pulling ancient RCS comments
[perl5.git] / t / op / my.t
1 #!./perl
2
3 print "1..34\n";
4
5 sub foo {
6     my($a, $b) = @_;
7     my $c;
8     my $d;
9     $c = "ok 3\n";
10     $d = "ok 4\n";
11     { my($a, undef, $c) = ("ok 9\n", "not ok 10\n", "ok 10\n");
12       ($x, $y) = ($a, $c); }
13     print $a, $b;
14     $c . $d;
15 }
16
17 $a = "ok 5\n";
18 $b = "ok 6\n";
19 $c = "ok 7\n";
20 $d = "ok 8\n";
21
22 print &foo("ok 1\n","ok 2\n");
23
24 print $a,$b,$c,$d,$x,$y;
25
26 # same thing, only with arrays and associative arrays
27
28 sub foo2 {
29     my($a, @b) = @_;
30     my(@c, %d);
31     @c = "ok 13\n";
32     $d{''} = "ok 14\n";
33     { my($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); }
34     print $a, @b;
35     $c[0] . $d{''};
36 }
37
38 $a = "ok 15\n";
39 @b = "ok 16\n";
40 @c = "ok 17\n";
41 $d{''} = "ok 18\n";
42
43 print &foo2("ok 11\n","ok 12\n");
44
45 print $a,@b,@c,%d,$x,$y;
46
47 my $i = "outer";
48
49 if (my $i = "inner") {
50     print "not " if $i ne "inner";
51 }
52 print "ok 21\n";
53
54 if ((my $i = 1) == 0) {
55     print "not ";
56 }
57 else {
58     print "not" if $i != 1;
59 }
60 print "ok 22\n";
61
62 my $j = 5;
63 while (my $i = --$j) {
64     print("not "), last unless $i > 0;
65 }
66 continue {
67     print("not "), last unless $i > 0;
68 }
69 print "ok 23\n";
70
71 $j = 5;
72 for (my $i = 0; (my $k = $i) < $j; ++$i) {
73     print("not "), last unless $i >= 0 && $i < $j && $i == $k;
74 }
75 print "ok 24\n";
76 print "not " if defined $k;
77 print "ok 25\n";
78
79 foreach my $i (26, 27) {
80     print "ok $i\n";
81 }
82
83 print "not " if $i ne "outer";
84 print "ok 28\n";
85
86 # Ensure that C<my @y> (without parens) doesn't force scalar context.
87 my @x;
88 { @x = my @y }
89 print +(@x ? "not " : ""), "ok 29\n";
90 { @x = my %y }
91 print +(@x ? "not " : ""), "ok 30\n";
92
93 # Found in HTML::FormatPS
94 my %fonts = qw(nok 31);
95 for my $full (keys %fonts) {
96     $full =~ s/^n//;
97     # Supposed to be copy-on-write via force_normal after a THINKFIRST check.
98     print "$full $fonts{nok}\n";
99 }
100
101 #  [perl #29340] optimising away the = () left the padav returning the
102 # array rather than the contents, leading to 'Bizarre copy of array' error
103
104 sub opta { my @a=() }
105 sub opth { my %h=() }
106 eval { my $x = opta };
107 print "not " if $@;
108 print "ok 32\n";
109 eval { my $x = opth };
110 print "not " if $@;
111 print "ok 33\n";
112
113
114 sub foo3 {
115     ++my $x->{foo};
116     print "not " if defined $x->{bar};
117     ++$x->{bar};
118 }
119 eval { foo3(); foo3(); };
120 print "not " if $@;
121 print "ok 34\n";
122