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{ 15 class Test1 { 16 method hello { return "hello, world"; } 17 } 18 19 my $obj = Test1->new; 20 isa_ok($obj, "Test1", '$obj'); 21 22 is($obj->hello, "hello, world", '$obj->hello'); 23} 24 25# Classes are still regular packages 26{ 27 class Test2 { 28 my $ok = "OK"; 29 sub NotAMethod { return $ok } 30 } 31 32 is(Test2::NotAMethod(), "OK", 'Class can contain regular subs'); 33} 34 35# Classes accept full package names 36{ 37 class Test3::Foo { 38 method hello { return "This" } 39 } 40 is(Test3::Foo->new->hello, "This", 'Class supports fully-qualified package names'); 41} 42 43# Unit class 44{ 45 class Test4::A; 46 method m { return "unit-A" } 47 48 class Test4::B; 49 method m { return "unit-B" } 50 51 package main; 52 ok(eq_array([Test4::A->new->m, Test4::B->new->m], ["unit-A", "unit-B"]), 53 'Unit class syntax works'); 54} 55 56# Class {BLOCK} syntax parses like package 57{ 58 my $result = ""; 59 eval q{ 60 $result .= "a(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n"; 61 class Test5 1.23 { 62 $result .= "b(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n"; 63 } 64 $result .= "c(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n"; 65 } or die $@; 66 is($result, "a(main/main)\nb(Test5/Test5)\nc(main/main)\n", 67 'class sets __PACKAGE__ correctly'); 68 is($Test5::VERSION, 1.23, 'class NAME VERSION { BLOCK } sets $VERSION'); 69} 70 71# Unit class syntax parses like package 72{ 73 my $result = ""; 74 eval q{ 75 $result .= "a(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n"; 76 class Test6 4.56; 77 $result .= "b(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n"; 78 package main; 79 $result .= "c(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n"; 80 } or die $@; 81 is($result, "a(main/main)\nb(Test6/Test6)\nc(main/main)\n", 82 'class sets __PACKAGE__ correctly'); 83 is($Test6::VERSION, 4.56, 'class NAME VERSION; sets $VERSION'); 84} 85 86done_testing; 87