1my %global_hash; 2my @global_array; 3my $global_scalar; 4sub global_sub {} 5 6my %global_hash2; 7my @global_array2; 8my $global_scalar2; 9sub global_sub2 {} 10 11# Test basic coercions... 12package BaseClass; 13use Class::Std; 14{ 15 sub as_str : STRINGIFY { return 'hello world' } 16 sub as_num : NUMERIFY { return 42 } 17 sub as_bool : BOOLIFY { return } 18 19 sub as_code : CODIFY { return \&::global_sub } 20 sub as_glob : GLOBIFY { return \*::global_glob } 21 sub as_hash : HASHIFY { return \%global_hash } 22 sub as_array : ARRAYIFY { return \@global_array } 23 sub as_scalar : SCALARIFY { return \$global_scalar } 24} 25 26# Test inheritance without change... 27package DerClass; 28use base qw( BaseClass ); 29 30# Test inheritance with change... 31package DerClass2; 32use Class::Std; 33use base qw( BaseClass ); 34{ 35 sub as_str : STRINGIFY { return 'goodbye world' } 36 sub as_num : NUMERIFY { return 86 } 37 sub as_bool : BOOLIFY { return 1 } 38 39 sub as_code : CODIFY { return \&::global_sub2 } 40 sub as_glob : GLOBIFY { return \*::global_glob2 } 41 sub as_hash : HASHIFY { return \%global_hash2 } 42 sub as_array : ARRAYIFY { return \@global_array2 } 43 sub as_scalar : SCALARIFY { return \$global_scalar2 } 44} 45 46# Test inheritance with change and they didn't "use Class::Std" 47package DerClass3; 48use base qw( BaseClass ); 49{ 50 sub as_str : STRINGIFY { return 'goodbye world' } 51 sub as_num : NUMERIFY { return 86 } 52 sub as_bool : BOOLIFY { return 1 } 53 54 sub as_code : CODIFY { return \&::global_sub2 } 55 sub as_glob : GLOBIFY { return \*::global_glob2 } 56 sub as_hash : HASHIFY { return \%global_hash2 } 57 sub as_array : ARRAYIFY { return \@global_array2 } 58 sub as_scalar : SCALARIFY { return \$global_scalar2 } 59} 60 61# Test inheritance with change and they don't re-specify the coercions 62package DerClass4; 63use base qw( BaseClass ); 64{ 65 sub as_str { return 'goodbye world' } 66 sub as_num { return 86 } 67 sub as_bool { return 1 } 68 69 sub as_code { return \&::global_sub2 } 70 sub as_glob { return \*::global_glob2 } 71 sub as_hash { return \%global_hash2 } 72 sub as_array { return \@global_array2 } 73 sub as_scalar { return \$global_scalar2 } 74} 75 76# Test inheritance with changing the subs used for the coercions 77package DerClass5; 78use base qw( BaseClass ); 79{ 80 sub as_str_changed : STRINGIFY { return 'goodbye world' } 81 sub as_num_changed : NUMERIFY { return 86 } 82 sub as_bool_changed : BOOLIFY { return 1 } 83 84 sub as_code_changed : CODIFY { return \&::global_sub2 } 85 sub as_glob_changed : GLOBIFY { return \*::global_glob2 } 86 sub as_hash_changed : HASHIFY { return \%global_hash2 } 87 sub as_array_changed : ARRAYIFY { return \@global_array2 } 88 sub as_scalar_changed : SCALARIFY { return \$global_scalar2 } 89} 90 91 92package main; 93 94use Test::More 'no_plan'; 95 96my $obj; 97 98# Basic coercions... 99 100$obj = BaseClass->new(); 101 102ok !$obj => 'Base Boolean coercion'; 103is 0+$obj, 42 => 'Base Numeric coercion'; 104is "$obj", 'hello world' => 'Base String coercion'; 105 106is \&{$obj}, \&global_sub => 'Base Code coercion'; 107is \*{$obj}, \*global_glob => 'Base Glob coercion'; 108is \%{$obj}, \%global_hash => 'Base Hash coercion'; 109is \@{$obj}, \@global_array => 'Base Array coercion'; 110is \${$obj}, \$global_scalar => 'Base Scalar coercion'; 111 112 113# Inheriting coercions... 114 115$obj = DerClass->new(); 116 117ok !$obj => 'Der Boolean coercion'; 118is 0+$obj, 42 => 'Der Numeric coercion'; 119is "$obj", 'hello world' => 'Der String coercion'; 120 121is \&{$obj}, \&global_sub => 'Der Code coercion'; 122is \*{$obj}, \*global_glob => 'Der Glob coercion'; 123is \%{$obj}, \%global_hash => 'Der Hash coercion'; 124is \@{$obj}, \@global_array => 'Der Array coercion'; 125is \${$obj}, \$global_scalar => 'Der Scalar coercion'; 126 127 128# Redefining coercions on inheritance... 129 130$obj = DerClass2->new(); 131 132ok $obj => 'Der2 Boolean coercion'; 133is 0+$obj, 86 => 'Der2 Numeric coercion'; 134is "$obj", 'goodbye world' => 'Der2 String coercion'; 135 136is \&{$obj}, \&global_sub2 => 'Der2 Code coercion'; 137is \*{$obj}, \*global_glob2 => 'Der2 Glob coercion'; 138is \%{$obj}, \%global_hash2 => 'Der2 Hash coercion'; 139is \@{$obj}, \@global_array2 => 'Der2 Array coercion'; 140is \${$obj}, \$global_scalar2 => 'Der2 Scalar coercion'; 141 142 143# Redefining coercions on inheritance and there is no "use Class::Std" 144# in the subclass 145 146$obj = DerClass3->new(); 147 148ok $obj => 'Der3 Boolean coercion'; 149is 0+$obj, 86 => 'Der3 Numeric coercion'; 150is "$obj", 'goodbye world' => 'Der3 String coercion'; 151 152is \&{$obj}, \&global_sub2 => 'Der3 Code coercion'; 153is \*{$obj}, \*global_glob2 => 'Der3 Glob coercion'; 154is \%{$obj}, \%global_hash2 => 'Der3 Hash coercion'; 155is \@{$obj}, \@global_array2 => 'Der3 Array coercion'; 156is \${$obj}, \$global_scalar2 => 'Der3 Scalar coercion'; 157 158 159# The subclass doesn't need to specify the coercions again 160 161$obj = DerClass4->new(); 162 163ok $obj => 'Der4 Boolean coercion'; 164is 0+$obj, 86 => 'Der4 Numeric coercion'; 165is "$obj", 'goodbye world' => 'Der4 String coercion'; 166 167is \&{$obj}, \&global_sub2 => 'Der4 Code coercion'; 168is \*{$obj}, \*global_glob2 => 'Der4 Glob coercion'; 169is \%{$obj}, \%global_hash2 => 'Der4 Hash coercion'; 170is \@{$obj}, \@global_array2 => 'Der4 Array coercion'; 171is \${$obj}, \$global_scalar2 => 'Der4 Scalar coercion'; 172 173 174# The subclass doesn't need to specify the coercions again 175 176$obj = DerClass5->new(); 177 178ok $obj => 'Der5 Boolean coercion'; 179is 0+$obj, 86 => 'Der5 Numeric coercion'; 180is "$obj", 'goodbye world' => 'Der5 String coercion'; 181 182is \&{$obj}, \&global_sub2 => 'Der5 Code coercion'; 183is \*{$obj}, \*global_glob2 => 'Der5 Glob coercion'; 184is \%{$obj}, \%global_hash2 => 'Der5 Hash coercion'; 185is \@{$obj}, \@global_array2 => 'Der5 Array coercion'; 186is \${$obj}, \$global_scalar2 => 'Der5 Scalar coercion'; 187 188