xref: /openbsd/gnu/usr.bin/perl/t/op/my.t (revision 17df1aa7)
1#!./perl
2
3print "1..36\n";
4
5sub 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
22print &foo("ok 1\n","ok 2\n");
23
24print $a,$b,$c,$d,$x,$y;
25
26# same thing, only with arrays and associative arrays
27
28sub 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
43print &foo2("ok 11\n","ok 12\n");
44
45print $a,@b,@c,%d,$x,$y;
46
47my $i = "outer";
48
49if (my $i = "inner") {
50    print "not " if $i ne "inner";
51}
52print "ok 21\n";
53
54if ((my $i = 1) == 0) {
55    print "not ";
56}
57else {
58    print "not" if $i != 1;
59}
60print "ok 22\n";
61
62my $j = 5;
63while (my $i = --$j) {
64    print("not "), last unless $i > 0;
65}
66continue {
67    print("not "), last unless $i > 0;
68}
69print "ok 23\n";
70
71$j = 5;
72for (my $i = 0; (my $k = $i) < $j; ++$i) {
73    print("not "), last unless $i >= 0 && $i < $j && $i == $k;
74}
75print "ok 24\n";
76print "not " if defined $k;
77print "ok 25\n";
78
79foreach my $i (26, 27) {
80    print "ok $i\n";
81}
82
83print "not " if $i ne "outer";
84print "ok 28\n";
85
86# Ensure that C<my @y> (without parens) doesn't force scalar context.
87my @x;
88{ @x = my @y }
89print +(@x ? "not " : ""), "ok 29\n";
90{ @x = my %y }
91print +(@x ? "not " : ""), "ok 30\n";
92
93# Found in HTML::FormatPS
94my %fonts = qw(nok 31);
95for 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
104sub opta { my @a=() }
105sub opth { my %h=() }
106eval { my $x = opta };
107print "not " if $@;
108print "ok 32\n";
109eval { my $x = opth };
110print "not " if $@;
111print "ok 33\n";
112
113
114sub foo3 {
115    ++my $x->{foo};
116    print "not " if defined $x->{bar};
117    ++$x->{bar};
118}
119eval { foo3(); foo3(); };
120print "not " if $@;
121print "ok 34\n";
122
123# my $foo = undef should always assign [perl #37776]
124{
125    my $count = 35;
126    loop:
127    my $test = undef;
128    print "not " if defined $test;
129    print "ok $count\n";
130    $test = 42;
131    goto loop if ++$count < 37;
132}
133