view release on metacpan or  search on metacpan

t/55-validate-strings.t  view on Meta::CPAN

   my $zCfg5 = init_config ( $str, $alias, 1);
   my $szCfg5 = $zCfg5->get_section ($sect);
   dbug_ok ( defined $szCfg5, "Section exists" );

   dbug_ok ( test_obj ($xCfg1, $zCfg5,  [ "abc", "xyz", "cmt1", "cmt2", "cmt3", "cmt4" ], [] ), "Compares alternate main OK" );
   dbug_ok ( test_obj ($sxCfg1, $szCfg5, [ "lmn", "no" ], [] ),  "Compares alternate section OK" );

   # Since I didn't count the test cases, must end my program
   # with a call to this method.  Can't do tests in END anymore!
   done_testing ();

   DBUG_LEAVE (0);
}


# --------------------------------------------------
# Compares two Advanced::Config objects ...
# --------------------------------------------------
sub test_obj
{
   DBUG_ENTER_FUNC ( @_ );
   my $src  = shift;
   my $dst  = shift;
   my $good = shift;   # Array of tags that should match
   my $bad  = shift;   # Array of tags that shouldn't match

   unless ( defined $src && defined $dst ) {
      return DBUG_RETURN (0);
   }

   DBUG_PAUSE ();

   # It's a fatal error if any tag in the "good" array doesn't exist!
   my $ok = 1;
   foreach ( @{$good} ) {
      my $s = $src->get_value ($_);
      my $d = $dst->get_value ($_);
      if ( $s ne $d ) {
         $ok = 0;
         dbug_ok (0, "Tags $_ doesn't match!  (${s} vs ${d})");
      }
   }

   # It's a fatal error if any tag in the "bad" array doesn't exist!
   foreach ( @{$bad} ) {
      my $s = $src->get_value ($_);
      my $d = $dst->get_value ($_);
      if ( $s eq $d ) {
         $ok = 0;
         dbug_ok (0, "Tags $_ match when they shouldn't!  (${s})");
      }
   }

   DBUG_RETURN ( $ok );
}

# ====================================================================
# Tests the results.
# Only prints out failures when testing the contents.
# There are just too many tests otherwise to debug things!
# ====================================================================
sub test_results
{
   DBUG_ENTER_FUNC ( @_ );
   my $cfg = shift;
   my $mis = shift;   # The list of tags not in the string config.

   my @lst1 = sort keys %Config;
   my @lst2 = sort $cfg->find_tags ();

   my $cnt1 = @lst1;
   my $cnt2 = @lst2;

   # Convert the "string" config file into a hash to simplify testing ...
   my %val2;
   foreach ( @lst2 ) {
      my $val = $cfg->get_value ( $_ );
      $val2{$_} = $val;
   }

   # Now add in the missing entries ... (no overrides)
   foreach ( sort keys %{$mis} ) {
      next  if ( exists $val2{$_} );
      $val2{$_} = $mis->{$_};
      ++$cnt2;
   }

   dbug_is ($cnt1, $cnt2, "The object has the correct number of tags in it!  ($cnt1 vs $cnt2)");

   # Checks to see if there were any tags in the string that wasn't in %Config.
   foreach ( @lst2 ) {
      unless ( exists $Config{$_} ) {
         dbug_ok (0, "Found tag $_ in the %Config hash!");
      }
   }

   # Only prints out errors.  Otherwise over 1,000 tests printed out.
   foreach ( @lst1 ) {
      unless ( exists $val2{$_} ) {
         dbug_ok ( 0, "Tag $_ exists in the string config file!");
         next;
      }

      # Some Config values are undefined ...
      unless ( defined $Config{$_} ) {
         if ( $val2{$_} ne "undef" ) {
            dbug_ok ( 0, "Tag $_ is set to 'undef'.  ($val2{$_})");
         }
         next;
      }

      if ( $Config{$_} ne $val2{$_} ) {
         dbug_ok ( 0, "Tag $_ is set to the proper value ($Config{$_} vs $val2{$_})" );
         next;
      }
   }

   DBUG_VOID_RETURN ();
}