t_attic/37_delete_edge_cases.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 4;
   6 use Test::Deep;
   7 use Clone qw( clone );
   8 use t::common qw( new_fh );
   9
  10 use_ok( 'DBM::Deep' );
  11
  12 my ($fh, $filename) = new_fh();
  13 my $db = DBM::Deep->new( $filename );
  14
  15 my $x = {
  16     a => 1,
  17     b => 2,
  18     c => [ 1 .. 3 ],
  19 };
  20
  21 my $x_save = clone( $x );
  22
  23 $db->{foo} = $x;
  24
  25 ok( tied(%$x), "\$x is tied" );
  26 delete $db->{foo};
  27
  28 TODO: {
  29     local $TODO = "Delete isn't working right";
  30     ok( !tied(%$x), "\$x is NOT tied" );
  31     cmp_deeply( $x, $x_save, "When it's deleted, it's untied" );
  32 }