my %global_hash; my @global_array; my $global_scalar; sub global_sub {} my %global_hash2; my @global_array2; my $global_scalar2; sub global_sub2 {} # Test basic coercions... package BaseClass; use Class::Std; { sub as_str : STRINGIFY { return 'hello world' } sub as_num : NUMERIFY { return 42 } sub as_bool : BOOLIFY { return } sub as_code : CODIFY { return \&::global_sub } sub as_glob : GLOBIFY { return \*::global_glob } sub as_hash : HASHIFY { return \%global_hash } sub as_array : ARRAYIFY { return \@global_array } sub as_scalar : SCALARIFY { return \$global_scalar } } # Test inheritance without change... package DerClass; use base qw( BaseClass ); # Test inheritance with change... package DerClass2; use Class::Std; use base qw( BaseClass ); { sub as_str : STRINGIFY { return 'goodbye world' } sub as_num : NUMERIFY { return 86 } sub as_bool : BOOLIFY { return 1 } sub as_code : CODIFY { return \&::global_sub2 } sub as_glob : GLOBIFY { return \*::global_glob2 } sub as_hash : HASHIFY { return \%global_hash2 } sub as_array : ARRAYIFY { return \@global_array2 } sub as_scalar : SCALARIFY { return \$global_scalar2 } } # Test inheritance with change and they didn't "use Class::Std" package DerClass3; use base qw( BaseClass ); { sub as_str : STRINGIFY { return 'goodbye world' } sub as_num : NUMERIFY { return 86 } sub as_bool : BOOLIFY { return 1 } sub as_code : CODIFY { return \&::global_sub2 } sub as_glob : GLOBIFY { return \*::global_glob2 } sub as_hash : HASHIFY { return \%global_hash2 } sub as_array : ARRAYIFY { return \@global_array2 } sub as_scalar : SCALARIFY { return \$global_scalar2 } } # Test inheritance with change and they don't re-specify the coercions package DerClass4; use base qw( BaseClass ); { sub as_str { return 'goodbye world' } sub as_num { return 86 } sub as_bool { return 1 } sub as_code { return \&::global_sub2 } sub as_glob { return \*::global_glob2 } sub as_hash { return \%global_hash2 } sub as_array { return \@global_array2 } sub as_scalar { return \$global_scalar2 } } # Test inheritance with changing the subs used for the coercions package DerClass5; use base qw( BaseClass ); { sub as_str_changed : STRINGIFY { return 'goodbye world' } sub as_num_changed : NUMERIFY { return 86 } sub as_bool_changed : BOOLIFY { return 1 } sub as_code_changed : CODIFY { return \&::global_sub2 } sub as_glob_changed : GLOBIFY { return \*::global_glob2 } sub as_hash_changed : HASHIFY { return \%global_hash2 } sub as_array_changed : ARRAYIFY { return \@global_array2 } sub as_scalar_changed : SCALARIFY { return \$global_scalar2 } } package main; use Test::More 'no_plan'; my $obj; # Basic coercions... $obj = BaseClass->new(); ok !$obj => 'Base Boolean coercion'; is 0+$obj, 42 => 'Base Numeric coercion'; is "$obj", 'hello world' => 'Base String coercion'; is \&{$obj}, \&global_sub => 'Base Code coercion'; is \*{$obj}, \*global_glob => 'Base Glob coercion'; is \%{$obj}, \%global_hash => 'Base Hash coercion'; is \@{$obj}, \@global_array => 'Base Array coercion'; is \${$obj}, \$global_scalar => 'Base Scalar coercion'; # Inheriting coercions... $obj = DerClass->new(); ok !$obj => 'Der Boolean coercion'; is 0+$obj, 42 => 'Der Numeric coercion'; is "$obj", 'hello world' => 'Der String coercion'; is \&{$obj}, \&global_sub => 'Der Code coercion'; is \*{$obj}, \*global_glob => 'Der Glob coercion'; is \%{$obj}, \%global_hash => 'Der Hash coercion'; is \@{$obj}, \@global_array => 'Der Array coercion'; is \${$obj}, \$global_scalar => 'Der Scalar coercion'; # Redefining coercions on inheritance... $obj = DerClass2->new(); ok $obj => 'Der2 Boolean coercion'; is 0+$obj, 86 => 'Der2 Numeric coercion'; is "$obj", 'goodbye world' => 'Der2 String coercion'; is \&{$obj}, \&global_sub2 => 'Der2 Code coercion'; is \*{$obj}, \*global_glob2 => 'Der2 Glob coercion'; is \%{$obj}, \%global_hash2 => 'Der2 Hash coercion'; is \@{$obj}, \@global_array2 => 'Der2 Array coercion'; is \${$obj}, \$global_scalar2 => 'Der2 Scalar coercion'; # Redefining coercions on inheritance and there is no "use Class::Std" # in the subclass $obj = DerClass3->new(); ok $obj => 'Der3 Boolean coercion'; is 0+$obj, 86 => 'Der3 Numeric coercion'; is "$obj", 'goodbye world' => 'Der3 String coercion'; is \&{$obj}, \&global_sub2 => 'Der3 Code coercion'; is \*{$obj}, \*global_glob2 => 'Der3 Glob coercion'; is \%{$obj}, \%global_hash2 => 'Der3 Hash coercion'; is \@{$obj}, \@global_array2 => 'Der3 Array coercion'; is \${$obj}, \$global_scalar2 => 'Der3 Scalar coercion'; # The subclass doesn't need to specify the coercions again $obj = DerClass4->new(); ok $obj => 'Der4 Boolean coercion'; is 0+$obj, 86 => 'Der4 Numeric coercion'; is "$obj", 'goodbye world' => 'Der4 String coercion'; is \&{$obj}, \&global_sub2 => 'Der4 Code coercion'; is \*{$obj}, \*global_glob2 => 'Der4 Glob coercion'; is \%{$obj}, \%global_hash2 => 'Der4 Hash coercion'; is \@{$obj}, \@global_array2 => 'Der4 Array coercion'; is \${$obj}, \$global_scalar2 => 'Der4 Scalar coercion'; # The subclass doesn't need to specify the coercions again $obj = DerClass5->new(); ok $obj => 'Der5 Boolean coercion'; is 0+$obj, 86 => 'Der5 Numeric coercion'; is "$obj", 'goodbye world' => 'Der5 String coercion'; is \&{$obj}, \&global_sub2 => 'Der5 Code coercion'; is \*{$obj}, \*global_glob2 => 'Der5 Glob coercion'; is \%{$obj}, \%global_hash2 => 'Der5 Hash coercion'; is \@{$obj}, \@global_array2 => 'Der5 Array coercion'; is \${$obj}, \$global_scalar2 => 'Der5 Scalar coercion';