App-SimpleBackuper

 view release on metacpan or  search on metacpan

local/lib/perl5/Test/Deep.pm  view on Meta::CPAN

      $cmp = scalref($data);
    }
    elsif(($reftype eq 'Regexp') or ($reftype eq 'REGEXP'))
    {
      $cmp = regexpref($data);
    }
    else
    {
      $cmp = $Test::Deep::LeafWrapper
           ? $Test::Deep::LeafWrapper->($data)
           : shallow($data);
    }

    $WrapCache{$addr} = $cmp;
  }
  return $cmp;
}

sub _td_reftype
{
  my $val = shift;

  my $reftype = Scalar::Util::reftype($val);
  return '' unless defined $reftype;

  return $reftype unless $Test::Deep::RegexpVersion::OldStyle;

  my $blessed = Scalar::Util::blessed($val);
  return $reftype unless defined $blessed;

  if ($blessed && $blessed eq "Regexp" and $reftype eq "SCALAR")
  {
    $reftype = "Regexp"
  }

  return $reftype;
}

sub render_stack
{
  my ($var, $stack) = @_;

  return $stack->render($var);
}

sub cmp_methods
{
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  return cmp_deeply(shift, methods(@{shift()}), shift);
}

sub requireclass
{
  require Test::Deep::Class;

  my $val = shift;

  return Test::Deep::Class->new(1, $val);
}

# docs and export say this is called useclass, doh!

*useclass = \&requireclass;

sub noclass
{
  require Test::Deep::Class;

  my $val = shift;

  return Test::Deep::Class->new(0, $val);
}

sub set
{
  require Test::Deep::Set;

  return Test::Deep::Set->new(1, "", @_);
}

sub supersetof
{
  require Test::Deep::Set;

  return Test::Deep::Set->new(1, "sup", @_);
}

sub subsetof
{
  require Test::Deep::Set;

  return Test::Deep::Set->new(1, "sub", @_);
}

sub noneof
{
  require Test::Deep::Set;

  return Test::Deep::Set->new(1, "none", @_);
}

sub cmp_set
{
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  return cmp_deeply(shift, set(@{shift()}), shift);
}

sub bag
{
  require Test::Deep::Set;

  return Test::Deep::Set->new(0, "", @_);
}

sub superbagof
{
  require Test::Deep::Set;

  return Test::Deep::Set->new(0, "sup", @_);
}

local/lib/perl5/Test/Deep.pm  view on Meta::CPAN

  if (ref($hash) eq "HASH")
  {
    like($hash->{Name}, $name_pat, "name ok");
    like($hash->{Phone}, '/^0d{6}$/', "phone ok");
    my $cn = $hash->{ChildNames};
    if (ref($cn) eq "ARRAY")
    {
      foreach my $child (@$cn)
      {
        like($child, $name_pat);
      }
    }
    else
    {
        fail("child names not an array")
    }
  }
  else
  {
    fail("person not a hash");
  }

This is a horrible mess and because we don't know in advance how many
children's names there will be, we can't make a plan for our test anymore
(actually, we could but it would make things even more complicated).

Test::Deep to the rescue.

=head2 With Test::Deep

  my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
  cmp_deeply(
    $person,
    {
      Name => $name_re,
      Phone => re('^0d{6}$'),
      ChildNames => array_each($name_re)
    },
    "person ok"
  );

This will do everything that the messy code above does and it will give a
sensible message telling you exactly what went wrong if it finds a part of
$person that doesn't match the pattern. C<re()> and C<array_each()> are
special function imported from Test::Deep. They create a marker that tells
Test::Deep that something different is happening here. Instead of just doing
a simple comparison and checking are two things exactly equal, it should do
something else.

If a person was asked to check that 2 structures are equal, they could print
them both out and compare them line by line. The markers above are similar
to writing a note in red pen on one of the printouts telling the person that
for this piece of the structure, they should stop doing simple line by line
comparison and do something else.

C<re($regex)> means that Test::Deep should check that the current piece of
data matches the regex in C<$regex>. C<array_each($struct)> means that
Test::Deep should expect the current piece of data to be an array and it
should check that every element of that array matches C<$struct>.
In this case, every element of C<< $person->{ChildNames} >> should look like a
name. If say the 3rd one didn't you would get an error message something
like

  Using Regexp on $data->{ChildNames}[3]
     got    : 'Queen John Paul Sartre'
     expect : /^(Mr|Mrs|Miss) \w+ \w+$/

There are lots of other special comparisons available, see
L<SPECIAL COMPARISONS PROVIDED> below for the full list.

=head2 Reusing structures

Test::Deep is good for reusing test structures so you can do this

  my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
  my $person_cmp = {
    Name => $name_re,
    Phone => re('^0d{6}$'),
    ChildNames => array_each($name_re)
  };

  cmp_deeply($person1, $person_cmp, "person ok");
  cmp_deeply($person2, $person_cmp, "person ok");
  cmp_deeply($person3, $person_cmp, "person ok");

You can even put $person_cmp in a module and let other people use it when
they are writing test scripts for modules that use your modules.

To make things a little more difficult, lets change the person data
structure so that instead of a list of ChildNames, it contains a list of
hashes, one for each child. So in fact our person structure will contain
other person structures which may contain other person structures and so on.
This is easy to handle with Test::Deep because Test::Deep structures can
include themselves. Simply do

  my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
  my $person_cmp = {
    Name => $name_re,
    Phone => re('^0d{6}$'),
    # note no mention of Children here
  };

  $person_cmp->{Children} = array_each($person_cmp);

  cmp_deeply($person, $person_cmp, "person ok");

This will now check that $person->{Children} is an array and that every
element of that array also matches C<$person_cmp>, this includes checking
that its children also match the same pattern and so on.

=head2 Circular data structures

A circular data structure is one which loops back on itself, you can make
one easily by doing

  my @b;
  my @a = (1, 2, 3, \@b);
  push(@b, \@a);

now C<@a> contains a reference to be C<@b> and C<@b> contains a reference to
C<@a>. This causes problems if you have a program that wants to look inside

local/lib/perl5/Test/Deep.pm  view on Meta::CPAN

#pod   if (ref($hash) eq "HASH")
#pod   {
#pod     like($hash->{Name}, $name_pat, "name ok");
#pod     like($hash->{Phone}, '/^0d{6}$/', "phone ok");
#pod     my $cn = $hash->{ChildNames};
#pod     if (ref($cn) eq "ARRAY")
#pod     {
#pod       foreach my $child (@$cn)
#pod       {
#pod         like($child, $name_pat);
#pod       }
#pod     }
#pod     else
#pod     {
#pod         fail("child names not an array")
#pod     }
#pod   }
#pod   else
#pod   {
#pod     fail("person not a hash");
#pod   }
#pod
#pod This is a horrible mess and because we don't know in advance how many
#pod children's names there will be, we can't make a plan for our test anymore
#pod (actually, we could but it would make things even more complicated).
#pod
#pod Test::Deep to the rescue.
#pod
#pod =head2 With Test::Deep
#pod
#pod   my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
#pod   cmp_deeply(
#pod     $person,
#pod     {
#pod       Name => $name_re,
#pod       Phone => re('^0d{6}$'),
#pod       ChildNames => array_each($name_re)
#pod     },
#pod     "person ok"
#pod   );
#pod
#pod This will do everything that the messy code above does and it will give a
#pod sensible message telling you exactly what went wrong if it finds a part of
#pod $person that doesn't match the pattern. C<re()> and C<array_each()> are
#pod special function imported from Test::Deep. They create a marker that tells
#pod Test::Deep that something different is happening here. Instead of just doing
#pod a simple comparison and checking are two things exactly equal, it should do
#pod something else.
#pod
#pod If a person was asked to check that 2 structures are equal, they could print
#pod them both out and compare them line by line. The markers above are similar
#pod to writing a note in red pen on one of the printouts telling the person that
#pod for this piece of the structure, they should stop doing simple line by line
#pod comparison and do something else.
#pod
#pod C<re($regex)> means that Test::Deep should check that the current piece of
#pod data matches the regex in C<$regex>. C<array_each($struct)> means that
#pod Test::Deep should expect the current piece of data to be an array and it
#pod should check that every element of that array matches C<$struct>.
#pod In this case, every element of C<< $person->{ChildNames} >> should look like a
#pod name. If say the 3rd one didn't you would get an error message something
#pod like
#pod
#pod   Using Regexp on $data->{ChildNames}[3]
#pod      got    : 'Queen John Paul Sartre'
#pod      expect : /^(Mr|Mrs|Miss) \w+ \w+$/
#pod
#pod There are lots of other special comparisons available, see
#pod L<SPECIAL COMPARISONS PROVIDED> below for the full list.
#pod
#pod =head2 Reusing structures
#pod
#pod Test::Deep is good for reusing test structures so you can do this
#pod
#pod   my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
#pod   my $person_cmp = {
#pod     Name => $name_re,
#pod     Phone => re('^0d{6}$'),
#pod     ChildNames => array_each($name_re)
#pod   };
#pod
#pod   cmp_deeply($person1, $person_cmp, "person ok");
#pod   cmp_deeply($person2, $person_cmp, "person ok");
#pod   cmp_deeply($person3, $person_cmp, "person ok");
#pod
#pod You can even put $person_cmp in a module and let other people use it when
#pod they are writing test scripts for modules that use your modules.
#pod
#pod To make things a little more difficult, lets change the person data
#pod structure so that instead of a list of ChildNames, it contains a list of
#pod hashes, one for each child. So in fact our person structure will contain
#pod other person structures which may contain other person structures and so on.
#pod This is easy to handle with Test::Deep because Test::Deep structures can
#pod include themselves. Simply do
#pod
#pod   my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
#pod   my $person_cmp = {
#pod     Name => $name_re,
#pod     Phone => re('^0d{6}$'),
#pod     # note no mention of Children here
#pod   };
#pod
#pod   $person_cmp->{Children} = array_each($person_cmp);
#pod
#pod   cmp_deeply($person, $person_cmp, "person ok");
#pod
#pod This will now check that $person->{Children} is an array and that every
#pod element of that array also matches C<$person_cmp>, this includes checking
#pod that its children also match the same pattern and so on.
#pod
#pod =head2 Circular data structures
#pod
#pod A circular data structure is one which loops back on itself, you can make
#pod one easily by doing
#pod
#pod   my @b;
#pod   my @a = (1, 2, 3, \@b);
#pod   push(@b, \@a);
#pod
#pod now C<@a> contains a reference to be C<@b> and C<@b> contains a reference to
#pod C<@a>. This causes problems if you have a program that wants to look inside