1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7 require Config; 8} 9 10use v5.36; 11use feature 'class'; 12no warnings 'experimental::class'; 13 14# $self in method 15{ 16 class Testcase1 { 17 method retself { return $self } 18 } 19 20 my $obj = Testcase1->new; 21 is($obj->retself, $obj, '$self inside method'); 22} 23 24# methods have signatures; signatures do not capture $self 25{ 26 # Turn off the 'signatures' feature to prove that 'method' is always 27 # signatured even without it 28 no feature 'signatures'; 29 30 class Testcase2 { 31 method retfirst ( $x = 123 ) { return $x; } 32 } 33 34 my $obj = Testcase2->new; 35 is($obj->retfirst, 123, 'method signature params work'); 36 is($obj->retfirst(456), 456, 'method signature params skip $self'); 37} 38 39# methods can still capture regular package lexicals 40{ 41 class Testcase3 { 42 my $count; 43 method inc { return $count++ } 44 } 45 46 my $obj1 = Testcase3->new; 47 $obj1->inc; 48 49 is($obj1->inc, 1, '$obj1->inc sees 1'); 50 51 my $obj2 = Testcase3->new; 52 is($obj2->inc, 2, '$obj2->inc sees 2'); 53} 54 55# $self is shifted from @_ 56{ 57 class Testcase4 { 58 method args { return @_ } 59 } 60 61 my $obj = Testcase4->new; 62 ok(eq_array([$obj->args("a", "b")], ["a", "b"]), '$self is shifted from @_'); 63} 64 65# anon methods 66{ 67 class Testcase5 { 68 method anonmeth { 69 return method { 70 return "Result"; 71 } 72 } 73 } 74 75 my $obj = Testcase5->new; 76 my $mref = $obj->anonmeth; 77 78 is($obj->$mref, "Result", 'anon method can be invoked'); 79} 80 81# methods can be forward declared without a body 82{ 83 class Testcase6 { 84 method forwarded; 85 86 method forwarded { return "OK" } 87 } 88 89 is(Testcase6->new->forwarded, "OK", 'forward-declared method works'); 90} 91 92done_testing; 93