t/96_virtual_functions.t

   1 #vim: ft=perl
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9 use lib 't/lib';
  10
  11 use_ok( 'DBM::Deep' );
  12
  13 throws_ok {
  14     DBM::Deep->new({ _test => 1 });
  15 } qr/lock_exclusive must be implemented in a child class/, 'Must define lock_exclusive in Storage';
  16
  17 {
  18     no strict 'refs';
  19     *{"DBM::Deep::Storage::Test::lock_exclusive"} = sub { 1 };
  20 }
  21
  22 throws_ok {
  23     DBM::Deep->new({ _test => 1 });
  24 } qr/setup must be implemented in a child class/, 'Must define setup in Engine';
  25
  26 {
  27     no strict 'refs';
  28     *{"DBM::Deep::Engine::Test::setup"} = sub { 1 };
  29 }
  30
  31 throws_ok {
  32     DBM::Deep->new({ _test => 1 });
  33 } qr/unlock must be implemented in a child class/, 'Must define unlock in Storage';
  34
  35 {
  36     no strict 'refs';
  37     *{"DBM::Deep::Storage::Test::unlock"} = sub { 1 };
  38 }
  39
  40 throws_ok {
  41     DBM::Deep->new({ _test => 1 });
  42 } qr/flush must be implemented in a child class/, 'Must define flush in Storage';
  43
  44 {
  45     no strict 'refs';
  46     *{"DBM::Deep::Storage::Test::flush"} = sub { 1 };
  47 }
  48
  49 my $db;
  50 lives_ok {
  51     $db = DBM::Deep->new({ _test => 1 });
  52 } "We finally have enough defined to instantiate";
  53
  54 throws_ok {
  55     $db->lock_shared;
  56 } qr/lock_shared must be implemented in a child class/, 'Must define lock_shared in Storage';
  57
  58 {
  59     no strict 'refs';
  60     *{"DBM::Deep::Storage::Test::lock_shared"} = sub { 1 };
  61 }
  62
  63 lives_ok {
  64     $db->lock_shared;
  65 } 'We have lock_shared defined';
  66
  67 # Yes, this is ordered for good reason. Think about it.
  68 my @methods = (
  69     'begin_work' => [
  70         Engine => 'begin_work',
  71     ],
  72     'rollback' => [
  73         Engine => 'rollback',
  74     ],
  75     'commit' => [
  76         Engine => 'commit',
  77     ],
  78     'supports' => [
  79         Engine => 'supports',
  80     ],
  81     'store' => [
  82         Storage => 'is_writable',
  83         Engine => 'write_value',
  84     ],
  85     'fetch' => [
  86         Engine => 'read_value',
  87     ],
  88     'delete' => [
  89         Engine => 'delete_key',
  90     ],
  91     'exists' => [
  92         Engine => 'key_exists',
  93     ],
  94     # Why is this one's error message bleeding through?
  95     'clear' => [
  96         Engine => 'clear',
  97     ],
  98 );
  99
 100 # Add the following:
 101 #    in_txn
 102
 103 # If only I could use natatime(). *sighs*
 104 while ( @methods ) {
 105     my ($entry, $requirements) = splice @methods, 0, 2;
 106     if ( $entry eq 'clear' ) {
 107         diag "Please ignore the spurious die for clear. I can't figure out how to prevent it"
 108     }
 109     while ( @$requirements ) {
 110         my ($class, $child_method) = splice @$requirements, 0, 2;
 111
 112         throws_ok {
 113             $db->$entry( 1 );
 114         } qr/$child_method must be implemented in a child class/,
 115         "'$entry' requires '$child_method' to be defined in the '$class'";
 116
 117         {
 118             no strict 'refs';
 119             *{"DBM::Deep::${class}::Test::${child_method}"} = sub { 1 };
 120         }
 121     }
 122
 123     lives_ok {
 124         $db->$entry( 1 );
 125     } "Finally have enough for '$entry' to work";
 126 }
 127
 128 throws_ok {
 129     $db->_engine->sector_type;
 130 } qr/sector_type must be implemented in a child class/, 'Must define sector_type in Storage';
 131
 132 {
 133     no strict 'refs';
 134     *{"DBM::Deep::Engine::Test::sector_type"} = sub { 'DBM::Deep::Iterator::Test' };
 135 }
 136
 137 lives_ok {
 138     $db->_engine->sector_type;
 139 } 'We have sector_type defined';
 140
 141 throws_ok {
 142     $db->first_key;
 143 } qr/iterator_class must be implemented in a child class/, 'Must define iterator_class in Iterator';
 144
 145 {
 146     no strict 'refs';
 147     *{"DBM::Deep::Engine::Test::iterator_class"} = sub { 'DBM::Deep::Iterator::Test' };
 148 }
 149
 150 throws_ok {
 151     $db->first_key;
 152 } qr/reset must be implemented in a child class/, 'Must define reset in Iterator';
 153
 154 {
 155     no strict 'refs';
 156     *{"DBM::Deep::Iterator::Test::reset"} = sub { 1 };
 157 }
 158
 159 throws_ok {
 160     $db->first_key;
 161 } qr/get_next_key must be implemented in a child class/, 'Must define get_next_key in Iterator';
 162
 163 {
 164     no strict 'refs';
 165     *{"DBM::Deep::Iterator::Test::get_next_key"} = sub { 1 };
 166 }
 167
 168 lives_ok {
 169     $db->first_key;
 170 } 'Finally have enough for first_key to work.';
 171
 172 done_testing;