home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _aaec6fe7fdbd63c9c90c3f70d420be6f < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.7 KB  |  69 lines
  1. use strict;
  2. use warnings;
  3.  
  4. sub 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.  
  23. sub 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.  
  68. 1;
  69.