Change 13442 by jhi@alpha on 2001/12/03 17:22:08
Subject: [PATCH] shared hash keys and ++/--
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Mon, 3 Dec 2001 16:37:16 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/pp.c#318 edit
.... //depot/perl/pp_hot.c#265 edit
.... //depot/perl/sv.c#494 edit
.... //depot/perl/t/op/inc.t#7 edit
Differences ...
==== //depot/perl/pp.c#318 (text) ====
Index: perl/pp.c
--- perl/pp.c.~1~ Mon Dec 3 10:30:05 2001
+++ perl/pp.c Mon Dec 3 10:30:05 2001
@@ -815,10 +815,10 @@
PP(pp_predec)
{
dSP;
- if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+ if (SvTYPE(TOPs) > SVt_PVLV)
DIE(aTHX_ PL_no_modify);
- if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
- SvIVX(TOPs) != IV_MIN)
+ if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
+ && SvIVX(TOPs) != IV_MIN)
{
--SvIVX(TOPs);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
@@ -832,11 +832,11 @@
PP(pp_postinc)
{
dSP; dTARGET;
- if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+ if (SvTYPE(TOPs) > SVt_PVLV)
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
- if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
- SvIVX(TOPs) != IV_MAX)
+ if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
+ && SvIVX(TOPs) != IV_MAX)
{
++SvIVX(TOPs);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
@@ -853,11 +853,11 @@
PP(pp_postdec)
{
dSP; dTARGET;
- if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+ if (SvTYPE(TOPs) > SVt_PVLV)
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
- if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
- SvIVX(TOPs) != IV_MIN)
+ if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
+ && SvIVX(TOPs) != IV_MIN)
{
--SvIVX(TOPs);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
==== //depot/perl/pp_hot.c#265 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c.~1~ Mon Dec 3 10:30:05 2001
+++ perl/pp_hot.c Mon Dec 3 10:30:05 2001
@@ -302,10 +302,10 @@
PP(pp_preinc)
{
dSP;
- if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+ if (SvTYPE(TOPs) > SVt_PVLV)
DIE(aTHX_ PL_no_modify);
- if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
- SvIVX(TOPs) != IV_MAX)
+ if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
+ && SvIVX(TOPs) != IV_MAX)
{
++SvIVX(TOPs);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
==== //depot/perl/sv.c#494 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Mon Dec 3 10:30:05 2001
+++ perl/sv.c Mon Dec 3 10:30:05 2001
@@ -5846,6 +5846,8 @@
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvTHINKFIRST(sv)) {
+ if (SvREADONLY(sv) && SvFAKE(sv))
+ sv_force_normal(sv);
if (SvREADONLY(sv)) {
if (PL_curcop != &PL_compiling)
Perl_croak(aTHX_ PL_no_modify);
@@ -6000,6 +6002,8 @@
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvTHINKFIRST(sv)) {
+ if (SvREADONLY(sv) && SvFAKE(sv))
+ sv_force_normal(sv);
if (SvREADONLY(sv)) {
if (PL_curcop != &PL_compiling)
Perl_croak(aTHX_ PL_no_modify);
==== //depot/perl/t/op/inc.t#7 (xtext) ====
Index: perl/t/op/inc.t
--- perl/t/op/inc.t.~1~ Mon Dec 3 10:30:05 2001
+++ perl/t/op/inc.t Mon Dec 3 10:30:05 2001
@@ -1,97 +1,153 @@
-#!./perl
+#!./perl -w
+
+# use strict;
+
+print "1..24\n";
+
+my $test = 1;
-print "1..12\n";
+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);
End of Patch.
