t/op/my.t

   1 #!./perl
   2
   3 print "1..36\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
 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 }