shared hash keys and ++/--

Message-ID: <20011203163716.C21702@plum.flirble.org>

p4raw-id: //depot/perl@13442

1 files changed, 108 insertions, 52 deletions

diff --git a/t/op/inc.t b/t/op/inc.t
index f59115e760..f360c031fe 100755
--- a/t/op/inc.t
+++ b/t/op/inc.t
@@ -1,97 +1,153 @@
-#!./perl
+#!./perl -w
 
-print "1..12\n";
+# use strict;
+
+print "1..24\n";
+
+my $test = 1;
+
+sub ok {
+  my ($pass, $wrong, $err) = @_;
+  if ($pass) {
+    print "ok $test\n";
+    $test = $test + 1; # Would be doubleplusbad to use ++ in the ++ test.
+    return 1;
+  } else {
+    if ($err) {
+      chomp $err;
+      print "not ok $test # $err\n";
+    } else {
+      if (defined $wrong) {
+        $wrong = ", got $wrong";
+      } else {
+        $wrong = '';
+      }
+      printf "not ok $test # line %d$wrong\n", (caller)[2];
+    }
+  }
+  $test = $test + 1;
+  return;
+}
 
 # Verify that addition/subtraction properly upgrade to doubles.
 # These tests are only significant on machines with 32 bit longs,
 # and two's complement negation, but shouldn't fail anywhere.
 
-$a = 2147483647;
-$c=$a++;
-if ($a == 2147483648) 
-	{print "ok 1\n"}
-else
-	{print "not ok 1\n";}
+my $a = 2147483647;
+my $c=$a++;
+ok ($a == 2147483648, $a);
 
 $a = 2147483647;
 $c=++$a;
-if ($a == 2147483648) 
-	{print "ok 2\n"}
-else
-	{print "not ok 2\n";}
+ok ($a == 2147483648, $a);
 
 $a = 2147483647;
 $a=$a+1;
-if ($a == 2147483648) 
-	{print "ok 3\n"}
-else
-	{print "not ok 3\n";}
+ok ($a == 2147483648, $a);
 
 $a = -2147483648;
 $c=$a--;
-if ($a == -2147483649) 
-	{print "ok 4\n"}
-else
-	{print "not ok 4\n";}
+ok ($a == -2147483649, $a);
 
 $a = -2147483648;
 $c=--$a;
-if ($a == -2147483649) 
-	{print "ok 5\n"}
-else
-	{print "not ok 5\n";}
+ok ($a == -2147483649, $a);
 
 $a = -2147483648;
 $a=$a-1;
-if ($a == -2147483649) 
-	{print "ok 6\n"}
-else
-	{print "not ok 6\n";}
+ok ($a == -2147483649, $a);
 
 $a = 2147483648;
 $a = -$a;
 $c=$a--;
-if ($a == -2147483649) 
-	{print "ok 7\n"}
-else
-	{print "not ok 7\n";}
+ok ($a == -2147483649, $a);
 
 $a = 2147483648;
 $a = -$a;
 $c=--$a;
-if ($a == -2147483649) 
-	{print "ok 8\n"}
-else
-	{print "not ok 8\n";}
+ok ($a == -2147483649, $a);
 
 $a = 2147483648;
 $a = -$a;
 $a=$a-1;
-if ($a == -2147483649) 
-	{print "ok 9\n"}
-else
-	{print "not ok 9\n";}
+ok ($a == -2147483649, $a);
 
 $a = 2147483648;
 $b = -$a;
 $c=$b--;
-if ($b == -$a-1) 
-	{print "ok 10\n"}
-else
-	{print "not ok 10\n";}
+ok ($b == -$a-1, $a);
 
 $a = 2147483648;
 $b = -$a;
 $c=--$b;
-if ($b == -$a-1) 
-	{print "ok 11\n"}
-else
-	{print "not ok 11\n";}
+ok ($b == -$a-1, $a);
 
 $a = 2147483648;
 $b = -$a;
 $b=$b-1;
-if ($b == -(++$a)) 
-	{print "ok 12\n"}
-else
-	{print "not ok 12\n";}
+ok ($b == -(++$a), $a);
+
+# Verify that shared hash keys become unshared.
+
+sub check_same {
+  my ($orig, $suspect) = @_;
+  my $fail;
+  while (my ($key, $value) = each %$suspect) {
+    if (exists $orig->{$key}) {
+      if ($orig->{$key} ne $value) {
+        print "# key '$key' was '$orig->{$key}' now '$value'\n";
+        $fail = 1;
+      }
+    } else {
+      print "# key '$key' is '$orig->{$key}', unexpect.\n";
+      $fail = 1;
+    }
+  }
+  foreach (keys %$orig) {
+    next if (exists $suspect->{$_});
+    print "# key '$_' was '$orig->{$_}' now missing\n";
+    $fail = 1;
+  }
+  ok (!$fail);
+}
+
+my (%orig) = my (%inc) = my (%dec) = my (%postinc) = my (%postdec)
+  = (1 => 1, ab => "ab");
+my %up = (1=>2, ab => 'ac');
+my %down = (1=>0, ab => -1);
+
+foreach (keys %inc) {
+  my $ans = $up{$_};
+  my $up;
+  eval {$up = ++$_};
+  ok ((defined $up and $up eq $ans), $up, $@);
+}
+
+check_same (\%orig, \%inc);
+
+foreach (keys %dec) {
+  my $ans = $down{$_};
+  my $down;
+  eval {$down = --$_};
+  ok ((defined $down and $down eq $ans), $down, $@);
+}
+
+check_same (\%orig, \%dec);
+
+foreach (keys %postinc) {
+  my $ans = $postinc{$_};
+  my $up;
+  eval {$up = $_++};
+  ok ((defined $up and $up eq $ans), $up, $@);
+}
+
+check_same (\%orig, \%postinc);
+
+foreach (keys %postdec) {
+  my $ans = $postdec{$_};
+  my $down;
+  eval {$down = $_--};
+  ok ((defined $down and $down eq $ans), $down, $@);
+}
+
+check_same (\%orig, \%postdec);