dist/Data-Dumper/t/seen.t

   1 #!./perl -w
   2 # t/seen.t - Test Seen()
   3
   4 use strict;
   5 use warnings;
   6
   7 use Data::Dumper;
   8 use Test::More tests => 10;
   9 use lib qw( ./t/lib );
  10 use Testing qw( _dumptostr );
  11
  12 my ($obj, %dumps);
  13
  14 my (@e, %f, @rv, @g, %h, $k);
  15 @e = ( qw| alpha beta gamma | );
  16 %f = ( epsilon => 'zeta', eta => 'theta' );
  17 @g = ( qw| iota kappa lambda | );
  18 %h = ( mu => 'nu', omicron => 'pi' );
  19 sub j { print "Hello world\n"; }
  20 $k = 'just another scalar';
  21
  22 {
  23     my $warning = '';
  24     local $SIG{__WARN__} = sub { $warning = $_[0] };
  25
  26     $obj = Data::Dumper->new( [ \@e, \%f ]);
  27     @rv = $obj->Seen( { mark => 'snark' } );
  28     like($warning,
  29         qr/^Only refs supported, ignoring non-ref item \$mark/,
  30         "Got expected warning for non-ref item");
  31 }
  32
  33 {
  34     my $warning = '';
  35     local $SIG{__WARN__} = sub { $warning = $_[0] };
  36
  37     $obj = Data::Dumper->new( [ \@e, \%f ]);
  38     @rv = $obj->Seen( { mark => undef } );
  39     like($warning,
  40         qr/^Value of ref must be defined; ignoring undefined item \$mark/,
  41         "Got expected warning for undefined value of item");
  42 }
  43
  44 {
  45     $obj = Data::Dumper->new( [ \@e, \%f ]);
  46     @rv = $obj->Seen( undef );
  47     is(@rv, 0, "Seen(undef) returned empty array");
  48 }
  49
  50 {
  51     $obj = Data::Dumper->new( [ \@e, \%f ]);
  52     @rv = $obj->Seen( [ qw| mark snark | ] );
  53     is(@rv, 0, "Seen(ref other than hashref) returned empty array");
  54 }
  55
  56 {
  57     $obj = Data::Dumper->new( [ \@e, \%f ]);
  58     @rv = $obj->Seen( { '*samba' => \@g } );
  59     is_deeply($rv[0], $obj, "Got the object back: value array ref");
  60 }
  61
  62 {
  63     $obj = Data::Dumper->new( [ \@e, \%f ]);
  64     @rv = $obj->Seen( { '*canasta' => \%h } );
  65     is_deeply($rv[0], $obj, "Got the object back: value hash ref");
  66 }
  67
  68 {
  69     $obj = Data::Dumper->new( [ \@e, \%f ]);
  70     @rv = $obj->Seen( { '*pinochle' => \&j } );
  71     is_deeply($rv[0], $obj, "Got the object back: value code ref");
  72 }
  73
  74 {
  75     $obj = Data::Dumper->new( [ \@e, \%f ]);
  76     @rv = $obj->Seen( { '*poker' => \$k } );
  77     is_deeply($rv[0], $obj, "Got the object back: value ref to scalar");
  78 }
  79
  80 {
  81     my $l = 'loo';
  82     $obj = Data::Dumper->new( [ \@e, \%f ]);
  83     @rv = $obj->Seen( { $l => \$k } );
  84     is_deeply($rv[0], $obj, "Got the object back: value ref to scalar");
  85 }
  86
  87 {
  88     my $l = '$loo';
  89     $obj = Data::Dumper->new( [ \@e, \%f ]);
  90     @rv = $obj->Seen( { $l => \$k } );
  91     is_deeply($rv[0], $obj, "Got the object back: value ref to scalar");
  92 }
  93