t/op/sub.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 plan( tests => 16 );
  10
  11 sub empty_sub {}
  12
  13 is(empty_sub,undef,"Is empty");
  14 is(empty_sub(1,2,3),undef,"Is still empty");
  15 @test = empty_sub();
  16 is(scalar(@test), 0, 'Didnt return anything');
  17 @test = empty_sub(1,2,3);
  18 is(scalar(@test), 0, 'Didnt return anything');
  19
  20 # RT #63790:  calling PL_sv_yes as a sub is special-cased to silently
  21 # return (so Foo->import() silently fails if import() doesn't exist),
  22 # But make sure it correctly pops the stack and mark stack before returning.
  23
  24 {
  25     my @a;
  26     push @a, 4, 5, main->import(6,7);
  27     ok(eq_array(\@a, [4,5]), "import with args");
  28
  29     @a = ();
  30     push @a, 14, 15, main->import;
  31     ok(eq_array(\@a, [14,15]), "import without args");
  32
  33     my $x = 1;
  34
  35     @a = ();
  36     push @a, 24, 25, &{$x == $x}(26,27);
  37     ok(eq_array(\@a, [24,25]), "yes with args");
  38
  39     @a = ();
  40     push @a, 34, 35, &{$x == $x};
  41     ok(eq_array(\@a, [34,35]), "yes without args");
  42 }
  43
  44 # [perl #81944] return should always copy
  45 {
  46     $foo{bar} = 7;
  47     for my $x ($foo{bar}) {
  48         # Pity test.pl doesnt have isn't.
  49         isnt \sub { delete $foo{bar} }->(), \$x,
  50            'result of delete(helem) is copied when returned';
  51     }
  52     $foo{bar} = 7;
  53     for my $x ($foo{bar}) {
  54         isnt \sub { return delete $foo{bar} }->(), \$x,
  55            'result of delete(helem) is copied when explicitly returned';
  56     }
  57     my $x;
  58     isnt \sub { delete $_[0] }->($x), \$x,
  59       'result of delete(aelem) is copied when returned';
  60     isnt \sub { return delete $_[0] }->($x), \$x,
  61       'result of delete(aelem) is copied when explicitly returned';
  62     isnt \sub { ()=\@_; shift }->($x), \$x,
  63       'result of shift is copied when returned';
  64     isnt \sub { ()=\@_; return shift }->($x), \$x,
  65       'result of shift is copied when explicitly returned';
  66 }
  67
  68 fresh_perl_is
  69   <<'end', "main::foo\n", {}, 'sub redefinition sets CvGV';
  70 *foo = \&baz;
  71 *bar = *foo;
  72 eval 'sub bar { print +(caller 0)[3], "\n" }';
  73 bar();
  74 end
  75
  76 fresh_perl_is
  77   <<'end', "main::foo\nok\n", {}, 'no double free redefining anon stub';
  78 my $sub = sub { 4 };
  79 *foo = $sub;
  80 *bar = *foo;
  81 undef &$sub;
  82 eval 'sub bar { print +(caller 0)[3], "\n" }';
  83 &$sub;
  84 undef *foo;
  85 undef *bar;
  86 print "ok\n";
  87 end