The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

#!./perl
BEGIN {
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
require Config;
}
use v5.36;
use feature 'class';
no warnings 'experimental::class';
{
class Testcase1 {
method hello { return "hello, world"; }
method classname { return __CLASS__; }
}
my $obj = Testcase1->new;
isa_ok($obj, "Testcase1", '$obj');
is($obj->hello, "hello, world", '$obj->hello');
is($obj->classname, "Testcase1", '$obj->classname yields __CLASS__');
}
# Classes are still regular packages
{
class Testcase2 {
my $ok = "OK";
sub NotAMethod { return $ok }
}
is(Testcase2::NotAMethod(), "OK", 'Class can contain regular subs');
}
# Classes accept full package names
{
class Testcase3::Foo {
method hello { return "This" }
}
is(Testcase3::Foo->new->hello, "This", 'Class supports fully-qualified package names');
}
# Unit class
{
class Testcase4::A;
method m { return "unit-A" }
class Testcase4::B;
method m { return "unit-B" }
package main;
ok(eq_array([Testcase4::A->new->m, Testcase4::B->new->m], ["unit-A", "unit-B"]),
'Unit class syntax works');
}
# Class {BLOCK} syntax parses like package
{
my $result = "";
eval q{
$result .= "a(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n";
class Testcase5 1.23 {
$result .= "b(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n";
}
$result .= "c(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n";
} or die $@;
is($result, "a(main/main)\nb(Testcase5/Testcase5)\nc(main/main)\n",
'class sets __PACKAGE__ correctly');
is($Testcase5::VERSION, 1.23, 'class NAME VERSION { BLOCK } sets $VERSION');
}
# Unit class syntax parses like package
{
my $result = "";
eval q{
$result .= "a(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n";
class Testcase6 4.56;
$result .= "b(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n";
package main;
$result .= "c(" . __PACKAGE__ . "/" . eval("__PACKAGE__") . ")\n";
} or die $@;
is($result, "a(main/main)\nb(Testcase6/Testcase6)\nc(main/main)\n",
'class sets __PACKAGE__ correctly');
is($Testcase6::VERSION, 4.56, 'class NAME VERSION; sets $VERSION');
}
done_testing;