Fix AUTOLOAD, or kill me
[perl.git] / t / op / method.t
1 #!./perl
2
3 #
4 # test method calls and autoloading.
5 #
6
7 print "1..20\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 {
28     local *B::d;
29     eval 'sub B::d {"B::d1"}';  # Import now.
30     test (A->d, "B::d1");       # Update hash table;
31     undef &B::d;
32     test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
33 }
34
35 test (A->d, "D::d");            # Back to previous state
36
37 eval 'sub B::d {"B::d2"}';      # Import now.
38 test (A->d, "B::d2");           # Update hash table;
39
40 # What follows is hardly guarantied to work, since the names in scripts
41 # are already linked to "pruned" globs. Say, `undef &B::d' if it were
42 # after `delete $B::{d}; sub B::d {}' would reach an old subroutine.
43
44 undef &B::d;
45 delete $B::{d};
46 test (A->d, "C::d");            # Update hash table;
47
48 eval 'sub B::d {"B::d3"}';      # Import now.
49 test (A->d, "B::d3");           # Update hash table;
50
51 delete $B::{d};
52 *dummy::dummy = sub {};         # Mark as updated
53 test (A->d, "C::d");
54
55 eval 'sub B::d {"B::d4"}';      # Import now.
56 test (A->d, "B::d4");           # Update hash table;
57
58 delete $B::{d};                 # Should work without any help too
59 test (A->d, "C::d");
60
61 *A::x = *A::d;                  # See if cache incorrectly follows synonyms
62 A->d;
63 test (eval { A->x } || "nope", "nope");
64
65 eval <<'EOF';
66 sub C::e;
67 BEGIN { *B::e = \&C::e }        # Shouldn't prevent AUTOLOAD in original pkg
68 sub Y::f;
69 $counter = 0;
70
71 @X::ISA = 'Y';
72 @Y::ISA = 'B';
73
74 sub B::AUTOLOAD {
75   my $c = ++$counter;
76   my $method = $B::AUTOLOAD; 
77   my $msg = "B: In $method, $c";
78   eval "sub $method { \$msg }";
79   goto &$method;
80 }
81 sub C::AUTOLOAD {
82   my $c = ++$counter;
83   my $method = $C::AUTOLOAD; 
84   my $msg = "C: In $method, $c";
85   eval "sub $method { \$msg }";
86   goto &$method;
87 }
88 EOF
89
90 test(A->e(), "C: In C::e, 1");  # We get a correct autoload
91 test(A->e(), "C: In C::e, 1");  # Which sticks
92
93 test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
94 test(A->ee(), "B: In A::ee, 2"); # Which sticks
95
96 test(Y->f(), "B: In Y::f, 3");  # We vivify a correct method
97 test(Y->f(), "B: In Y::f, 3");  # Which sticks
98
99 # This test is not intended to be reasonable. It is here just to let you
100 # know that you broke some old construction. Feel free to rewrite the test
101 # if your patch breaks it.
102
103 *B::AUTOLOAD = sub {
104   my $c = ++$counter;
105   my $method = $AUTOLOAD; 
106   *$AUTOLOAD = sub { "new B: In $method, $c" };
107   goto &$AUTOLOAD;
108 };
109
110 test(A->eee(), "new B: In A::eee, 4");  # We get a correct $autoload
111 test(A->eee(), "new B: In A::eee, 4");  # Which sticks