t/op/method.t

   1 #!./perl
   2
   3 #
   4 # test method calls and autoloading.
   5 #
   6
   7 print "1..18\n";
   8
   9 @A::ISA = 'B';
  10 @B::ISA = 'C';
  11
  12 sub C::d {"C::d"}
  13 sub D::d {"D::d"}
  14
  15 my $cnt = 0;
  16 sub test {
  17   print "# got `$_[0]', expected `$_[1]'\nnot " unless $_[0] eq $_[1];
  18   # print "not " unless shift eq shift;
  19   print "ok ", ++$cnt, "\n"
  20 }
  21
  22 test( A->d, "C::d");            # Update hash table;
  23
  24 *B::d = \&D::d;                 # Import now.
  25 test (A->d, "D::d");            # Update hash table;
  26
  27 eval 'sub B::d {"B::d1"}';      # Import now.
  28 test (A->d, "B::d1");           # Update hash table;
  29
  30 undef &B::d;                    # Should work without any help too
  31 test (A->d, "C::d");
  32
  33 eval 'sub B::d {"B::d2"}';      # Import now.
  34 test (A->d, "B::d2");           # Update hash table;
  35
  36 # What follows is hardly guarantied to work, since the names in scripts
  37 # are already linked to "pruned" globs. Say, `undef &B::d' if it were
  38 # after `delete $B::{d}; sub B::d {}' would reach an old subroutine.
  39
  40 undef &B::d;
  41 delete $B::{d};
  42 test (A->d, "C::d");            # Update hash table;
  43
  44 eval 'sub B::d {"B::d3"}';      # Import now.
  45 test (A->d, "B::d3");           # Update hash table;
  46
  47 delete $B::{d};
  48 *dummy::dummy = sub {};         # Mark as updated
  49 test (A->d, "C::d");
  50
  51 eval 'sub B::d {"B::d4"}';      # Import now.
  52 test (A->d, "B::d4");           # Update hash table;
  53
  54 delete $B::{d};                 # Should work without any help too
  55 test (A->d, "C::d");
  56
  57 eval <<'EOF';
  58 sub C::e;
  59 sub Y::f;
  60 $counter = 0;
  61
  62 @X::ISA = 'Y';
  63 @Y::ISA = 'B';
  64
  65 sub B::AUTOLOAD {
  66   my $c = ++$counter;
  67   my $method = $B::AUTOLOAD;
  68   *$B::AUTOLOAD = sub { "B: In $method, $c" };
  69   goto &$B::AUTOLOAD;
  70 }
  71 sub C::AUTOLOAD {
  72   my $c = ++$counter;
  73   my $method = $C::AUTOLOAD;
  74   *$C::AUTOLOAD = sub { "C: In $method, $c" };
  75   goto &$C::AUTOLOAD;
  76 }
  77 EOF
  78
  79 test(A->e(), "C: In C::e, 1");  # We get a correct autoload
  80 test(A->e(), "C: In C::e, 1");  # Which sticks
  81
  82 test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
  83 test(A->ee(), "B: In A::ee, 2"); # Which sticks
  84
  85 test(Y->f(), "B: In Y::f, 3");  # We vivify a correct method
  86 test(Y->f(), "B: In Y::f, 3");  # Which sticks
  87
  88 # This test is not intended to be reasonable. It is here just to let you
  89 # know that you broke some old construction. Feel free to rewrite the test
  90 # if your patch breaks it.
  91
  92 *B::AUTOLOAD = sub {
  93   my $c = ++$counter;
  94   my $method = $main::__ANON__;
  95   *$main::__ANON__ = sub { "new B: In $method, $c" };
  96   goto &$main::__ANON__;
  97 };
  98
  99 test(A->eee(), "new B: In A::eee, 4");  # We get a correct $autoload
 100 test(A->eee(), "new B: In A::eee, 4");  # Which sticks