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