This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
1e4 isn't large enough with 16 byte long doubles (at least on x86_64).
[perl5.git] / lib / dbm_filter_util.pl
CommitLineData
0e9b1cbd
PM
1use strict;
2use warnings;
3
4sub StoreData
5{
6 my $hashref = shift ;
7 my $store = shift ;
8
9 my (undef, $file, $line) = caller;
10 ok 1, "StoreData called from $file, line $line";
11
12 ok ref $store eq 'HASH', "Store Data is a hash reference";
13 ok tied %$hashref, "Storing to tied hash";
14
15 while (my ($k, $v) = each %$store) {
16 no warnings 'uninitialized';
17 #diag "Stored [$k][$v]";
18 $$hashref{$k} = $v ;
19 }
20
21}
22
23sub VerifyData
24{
25 my $hashref = shift ;
26 my $expected = shift ;
27 my %expected = %$expected;
28
29 my (undef, $file, $line) = caller;
30 ok 1, "VerifyData called from $file, line $line";
31
32 ok ref $expected eq 'HASH', "Expected data is a hash reference";
33 ok tied %$hashref, "Verifying a tied hash";
34
35 my %bad = ();
36 while (my ($k, $v) = each %$hashref) {
37 no warnings 'uninitialized';
38 if ($expected{$k} eq $v) {
39 #diag "Match [$k][$v]";
40 delete $expected{$k} ;
41 }
42 else {
43 #diag "No Match [$k][$v]";
44 $bad{$k} = $v;
45 }
46 }
47
48 if( ! ok(keys(%bad) + keys(%expected) == 0, "Expected == Actual") ) {
49 my $bad = "Expected does not match actual\n";
50 if (keys %expected ) {
51 $bad .=" No Match from Expected:\n" ;
52 while (my ($k, $v) = each %expected) {
53 $bad .= "\t'$k' =>\t'$v'\n";
54 }
55 }
56 if (keys %bad ) {
57 $bad .= "\n No Match from Actual:\n" ;
58 while (my ($k, $v) = each %bad) {
59 no warnings 'uninitialized';
60 $bad .= "\t'$k' =>\t'$v'\n";
61 }
62 }
63 diag "${bad}\n" ;
64 }
65}
66
67
681;