Integrate mainline.
Nick Ing-Simmons [Thu, 9 Nov 2000 20:34:11 +0000 (20:34 +0000)]
p4raw-id: //depot/perlio@7630

1  2 
t/lib/tie-refhash.t

@@@ -1,19 -1,19 +1,19 @@@
  #!/usr/bin/perl -w
--# 
++#
  # Basic test suite for Tie::RefHash and Tie::RefHash::Nestable.
--# 
++#
  # The testing is in two parts: first, run lots of tests on both a tied
  # hash and an ordinary un-tied hash, and check they give the same
  # answer.  Then there are tests for those cases where the tied hashes
  # should behave differently to normal hashes, that is, when using
  # references as keys.
--# 
++#
  
  BEGIN {
      chdir 't' if -d 't';
--    @INC = '.'; 
++    @INC = '.';
      push @INC, '../lib';
--}    
++}
  
  use strict;
  use Tie::RefHash;
@@@ -28,8 -28,9 +28,9 @@@ my $ref = []; my $ref1 = []
  # on a tied hash and on a normal hash, and checking that the results
  # are the same.  This does of course assume that Perl hashes are not
  # buggy :-)
--# 
++#
  my @tests = standard_hash_tests();
  my @ordinary_results = runtests(\@tests, undef);
  foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') {
      my @tied_results = runtests(\@tests, $class);
      foreach my $i (0 .. $#ordinary_results) {
          my ($or, $ow, $oe) = @{$ordinary_results[$i]};
          my ($tr, $tw, $te) = @{$tied_results[$i]};
--        
++
          my $ok = 1;
          local $^W = 0;
          $ok = 0 if (defined($or) != defined($tr)) or ($or ne $tr);
          $ok = 0 if (defined($ow) != defined($tw)) or ($ow ne $tw);
          $ok = 0 if (defined($oe) != defined($te)) or ($oe ne $te);
--        
++
          if (not $ok) {
              print STDERR
                "failed for $class: $tests[$i]\n",
@@@ -120,7 -127,7 +127,7 @@@ exit()
  
  # Print 'ok X' if true, 'not ok X' if false
  # Uses global $currtest.
--# 
++#
  sub test {
      my $t = shift;
      print 'not ' if not $t;
  }
  
  
--# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. 
++# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string.
  sub dumped {
      my $s = shift;
      my $d = Dumper($s);
  # Crudely dump a hash into a canonical string representation (because
  # hash keys can appear in any order, Data::Dumper may give different
  # strings for the same hash).
--# 
++#
  sub dumph {
      my $h = shift;
      my $r = '';
  }
  
  # Run the tests and give results.
--# 
++#
  # Parameters: reference to list of tests to run
  #             name of class to use for tied hash, or undef if not tied
--# 
++#
  # Returns: list of [R, W, E] tuples, one for each test.
  # R is the return value from running the test, W any warnings it gave,
  # and E any exception raised with 'die'.  E and W will be tidied up a
  # little to remove irrelevant details like line numbers :-)
--# 
++#
  # Will also run a few of its own 'ok N' tests.
--# 
++#
  sub runtests {
      my ($tests, $class) = @_;
      my @r;
  
  # Things that should work just the same for an ordinary hash and a
  # Tie::RefHash.
--# 
++#
  # Each test is a code string to be eval'd, it should do something with
  # %h and give a scalar return value.  The global $ref and $ref1 may
  # also be used.
--# 
++#
  # One thing we don't test is that the ordering from 'keys', 'values'
  # and 'each' is the same.  You can't reasonably expect that.
--# 
++#
  sub standard_hash_tests {
      my @r;
  
      my $STD_TESTS = <<'END'
      join $;, sort keys %h;
      join $;, sort values %h;
-     { my ($v, %tmp); %tmp{$v}++ while (defined($v = each %h)); dumph(\%tmp) }
-     { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%t
- mp) }
+     { my ($v, %tmp); $tmp{$v}++ while (defined($v = each %h)); dumph(\%tmp) }
+     { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) }
  END
    ;
--    
++
      # Tests on the existence of the element 'foo'
      my $FOO_TESTS = <<'END'
      defined $h{foo};
      exists $h{foo};
--    $h{foo};    
++    $h{foo};
  END
    ;
  
@@@ -268,7 -278,7 +278,7 @@@ EN
    ;
          }
      }
--    
++
      # Test hash slices
      my @slicetests;
      @slicetests = split /\n/, <<'END'