Add tests for all the error paths in Class::Struct.

1 files changed, 91 insertions, 0 deletions

diff --git a/lib/Class/Struct.t b/lib/Class/Struct.t
index 73ae6b7eb9..111c090a11 100644
--- a/lib/Class/Struct.t
+++ b/lib/Class/Struct.t
@@ -157,4 +157,95 @@ is $obj5->z_zwap, undef, 'No z_zwap member by default';
 isa_ok $obj5->sploosh, 'MyObj', 'Initialised sploosh member from hash';
 is_deeply $obj5->sploosh->h, { perl => 'rules'} , 'with correct object';
 
+is eval {
+    package MyObj;
+    struct( s => '$', a => '@', h => '%', c => 'aClass' );
+}, undef, 'Calling struct a second time fails';
+
+like $@, qr/^function 'new' already defined in package MyObj/,
+    'fails with the expected error';
+
+is eval { MyObj->new( a => {} ) }, undef,
+    'Using a hash where an array reference is expected';
+like $@, qr/^Initializer for a must be array reference/,
+    'fails with the expected error';
+
+is eval { MyObj->new( h => [] ) }, undef,
+    'Using an array where a hash reference is expected';
+like $@, qr/^Initializer for h must be hash reference/,
+    'fails with the expected error';
+
+is eval { Kapow->new( sploosh => { h => [perl => 'rules'] } ); }, undef,
+    'Using an array where a hash reference is expected in an initialiser list';
+like $@, qr/^Initializer for h must be hash reference/,
+    'fails with the expected error';
+
+is eval { Kapow->new( sploosh => [ h => {perl => 'rules'} ] ); }, undef,
+    "Using an array for a member object's initialiser list";
+like $@, qr/^Initializer for sploosh must be hash or MyObj reference/,
+    'fails with the expected error';
+
+is eval {
+    package Crraack;
+    use Class::Struct 'struct';
+    struct( 'pow' => '@$%!' );
+}, undef, 'Bad type fails';
+like $@, qr/^'\@\$\%\!' is not a valid struct element type/,
+    'with the expected error';
+
+is eval {
+    $obj3->sploosh(MyOther->new(s => 3.14));
+}, undef, 'Setting member to the wrong class of object fails';
+like $@, qr/^sploosh argument is wrong class/,
+    'with the expected error';
+is $obj3->sploosh->s, 'pie', 'Object is unchanged';
+
+is eval {
+    $obj3->sploosh(MyObj->new(s => 3.14), 'plop');
+}, undef, 'Too many arguments to setter fails';
+like $@, qr/^Too many args to sploosh/,
+    'with the expected error';
+is $obj3->sploosh->s, 'pie', 'Object is unchanged';
+
+is eval {
+    package Blurp;
+    use Class::Struct 'struct';
+    struct( Blurp => {}, 'Bonus!' );
+}, undef, 'hash based class with extra argument fails';
+like $@, qr/\Astruct usage error.*\n.*\n/,
+    'with the expected confession';
+
+is eval {
+    package Zamm;
+    use Class::Struct 'struct';
+    struct( Zamm => [], 'Bonus!' );
+}, undef, 'array based class with extra argument fails';
+like $@, qr/\Astruct usage error.*\n.*\n/,
+    'with the expected confession';
+
+is eval {
+    package Thwapp;
+    use Class::Struct 'struct';
+    struct( Thwapp => ['Bonus!'] );
+}, undef, 'array based class with extra constructor argument fails';
+like $@, qr/\Astruct usage error.*\n.*\n/,
+    'with the expected confession';
+
+is eval {
+    package Rakkk;
+    use Class::Struct 'struct';
+    struct( z_zwap => 'Regexp', sploosh => 'MyObj', 'Bonus' );
+}, undef, 'default array based class with extra constructor argument fails';
+like $@, qr/\Astruct usage error.*\n.*\n/,
+    'with the expected confession';
+
+is eval {
+    package Awk;
+    use parent -norequire, 'Urkkk';
+    use Class::Struct 'struct';
+    struct( beer => 'foamy' );
+}, undef, '@ISA is not allowed';
+like $@, qr/^struct class cannot be a subclass \(\@ISA not allowed\)/,
+    'with the expected error';
+
 done_testing;