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     while ( @$requirements ) {
 107         my ($class, $child_method) = splice @$requirements, 0, 2;
 108
 109         throws_ok {
 110             $db->$entry( 1 );
 111         } qr/$child_method must be implemented in a child class/,
 112         "'$entry' requires '$child_method' to be defined in the '$class'";
 113
 114         {
 115             no strict 'refs';
 116             *{"DBM::Deep::${class}::Test::${child_method}"} = sub { 1 };
 117         }
 118     }
 119
 120     lives_ok {
 121         $db->$entry( 1 );
 122     } "Finally have enough for '$entry' to work";
 123 }
 124
 125 throws_ok {
 126     $db->_engine->sector_type;
 127 } qr/sector_type must be implemented in a child class/, 'Must define sector_type in Storage';
 128
 129 {
 130     no strict 'refs';
 131     *{"DBM::Deep::Engine::Test::sector_type"} = sub { 'DBM::Deep::Iterator::Test' };
 132 }
 133
 134 lives_ok {
 135     $db->_engine->sector_type;
 136 } 'We have sector_type defined';
 137
 138 throws_ok {
 139     $db->first_key;
 140 } qr/iterator_class must be implemented in a child class/, 'Must define iterator_class in Iterator';
 141
 142 {
 143     no strict 'refs';
 144     *{"DBM::Deep::Engine::Test::iterator_class"} = sub { 'DBM::Deep::Iterator::Test' };
 145 }
 146
 147 throws_ok {
 148     $db->first_key;
 149 } qr/reset must be implemented in a child class/, 'Must define reset in Iterator';
 150
 151 {
 152     no strict 'refs';
 153     *{"DBM::Deep::Iterator::Test::reset"} = sub { 1 };
 154 }
 155
 156 throws_ok {
 157     $db->first_key;
 158 } qr/get_next_key must be implemented in a child class/, 'Must define get_next_key in Iterator';
 159
 160 {
 161     no strict 'refs';
 162     *{"DBM::Deep::Iterator::Test::get_next_key"} = sub { 1 };
 163 }
 164
 165 lives_ok {
 166     $db->first_key;
 167 } 'Finally have enough for first_key to work.';
 168
 169 done_testing;