Re: [perl #24816] Magic vars seem unsure if they are purely numeric

Message-Id:  <20040115221037.GA2392@efn.org>

Add sv_2iv_flags() to allow magic to be optionally processed.

p4raw-id: //depot/perl@22163

10 files changed, 275 insertions, 58 deletions

diff --git a/doop.c b/doop.c
index 6724aca814..47d64cb9f2 100644
--- a/doop.c
+++ b/doop.c
@@ -1135,8 +1135,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
 	sv_setpvn(sv, "", 0);	/* avoid undef warning on |= and ^= */
-    lsave = lc = SvPV(left, leftlen);
-    rsave = rc = SvPV(right, rightlen);
+    lsave = lc = SvPV_nomg(left, leftlen);
+    rsave = rc = SvPV_nomg(right, rightlen);
     len = leftlen < rightlen ? leftlen : rightlen;
     lensave = len;
     if ((left_utf || right_utf) && (sv == left || sv == right)) {
@@ -1145,7 +1145,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     }
     else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
 	STRLEN n_a;
-	dc = SvPV_force(sv, n_a);
+	dc = SvPV_force_nomg(sv, n_a);
 	if (SvCUR(sv) < (STRLEN)len) {
 	    dc = SvGROW(sv, (STRLEN)(len + 1));
 	    (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
diff --git a/embed.fnc b/embed.fnc
index 5ec0d10333..396f5b771f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -697,14 +697,16 @@ p	|void	|sub_crush_depth|CV* cv
 Apd	|bool	|sv_2bool	|SV* sv
 Apd	|CV*	|sv_2cv		|SV* sv|HV** st|GV** gvp|I32 lref
 Apd	|IO*	|sv_2io		|SV* sv
-Apd	|IV	|sv_2iv		|SV* sv
+Amb	|IV	|sv_2iv		|SV* sv
+Apd	|IV	|sv_2iv_flags	|SV* sv|I32 flags
 Apd	|SV*	|sv_2mortal	|SV* sv
 Apd	|NV	|sv_2nv		|SV* sv
 Amb	|char*	|sv_2pv		|SV* sv|STRLEN* lp
 Apd	|char*	|sv_2pvutf8	|SV* sv|STRLEN* lp
 Apd	|char*	|sv_2pvbyte	|SV* sv|STRLEN* lp
 Ap	|char*	|sv_pvn_nomg	|SV* sv|STRLEN* lp
-Apd	|UV	|sv_2uv		|SV* sv
+Amb	|UV	|sv_2uv		|SV* sv
+Apd	|UV	|sv_2uv_flags	|SV* sv|I32 flags
 Apd	|IV	|sv_iv		|SV* sv
 Apd	|UV	|sv_uv		|SV* sv
 Apd	|NV	|sv_nv		|SV* sv
diff --git a/embed.h b/embed.h
index b6a90ad79e..dd5a05dcb4 100644
--- a/embed.h
+++ b/embed.h
@@ -968,13 +968,13 @@
 #define sv_2bool		Perl_sv_2bool
 #define sv_2cv			Perl_sv_2cv
 #define sv_2io			Perl_sv_2io
-#define sv_2iv			Perl_sv_2iv
+#define sv_2iv_flags		Perl_sv_2iv_flags
 #define sv_2mortal		Perl_sv_2mortal
 #define sv_2nv			Perl_sv_2nv
 #define sv_2pvutf8		Perl_sv_2pvutf8
 #define sv_2pvbyte		Perl_sv_2pvbyte
 #define sv_pvn_nomg		Perl_sv_pvn_nomg
-#define sv_2uv			Perl_sv_2uv
+#define sv_2uv_flags		Perl_sv_2uv_flags
 #define sv_iv			Perl_sv_iv
 #define sv_uv			Perl_sv_uv
 #define sv_nv			Perl_sv_nv
@@ -3471,13 +3471,13 @@
 #define sv_2bool(a)		Perl_sv_2bool(aTHX_ a)
 #define sv_2cv(a,b,c,d)		Perl_sv_2cv(aTHX_ a,b,c,d)
 #define sv_2io(a)		Perl_sv_2io(aTHX_ a)
-#define sv_2iv(a)		Perl_sv_2iv(aTHX_ a)
+#define sv_2iv_flags(a,b)	Perl_sv_2iv_flags(aTHX_ a,b)
 #define sv_2mortal(a)		Perl_sv_2mortal(aTHX_ a)
 #define sv_2nv(a)		Perl_sv_2nv(aTHX_ a)
 #define sv_2pvutf8(a,b)		Perl_sv_2pvutf8(aTHX_ a,b)
 #define sv_2pvbyte(a,b)		Perl_sv_2pvbyte(aTHX_ a,b)
 #define sv_pvn_nomg(a,b)	Perl_sv_pvn_nomg(aTHX_ a,b)
-#define sv_2uv(a)		Perl_sv_2uv(aTHX_ a)
+#define sv_2uv_flags(a,b)	Perl_sv_2uv_flags(aTHX_ a,b)
 #define sv_iv(a)		Perl_sv_iv(aTHX_ a)
 #define sv_uv(a)		Perl_sv_uv(aTHX_ a)
 #define sv_nv(a)		Perl_sv_nv(aTHX_ a)
diff --git a/global.sym b/global.sym
index b9a65d2b96..06a29fe249 100644
--- a/global.sym
+++ b/global.sym
@@ -426,6 +426,7 @@ Perl_sv_2bool
 Perl_sv_2cv
 Perl_sv_2io
 Perl_sv_2iv
+Perl_sv_2iv_flags
 Perl_sv_2mortal
 Perl_sv_2nv
 Perl_sv_2pv
@@ -433,6 +434,7 @@ Perl_sv_2pvutf8
 Perl_sv_2pvbyte
 Perl_sv_pvn_nomg
 Perl_sv_2uv
+Perl_sv_2uv_flags
 Perl_sv_iv
 Perl_sv_uv
 Perl_sv_nv
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index 5a1bc57667..61e52a1874 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -2923,6 +2923,15 @@ Only use when you are sure SvIOK is true. See also C<SvIV()>.
 =for hackers
 Found in file sv.h
 
+=item SvIV_nomg
+
+Like C<SvIV> but doesn't process magic.
+
+	IV	SvIV_nomg(SV* sv)
+
+=for hackers
+Found in file sv.h
+
 =item SvLEN
 
 Returns the size of the string buffer in the SV, not including any part
@@ -3018,22 +3027,22 @@ which guarantees to evaluate sv only once.
 =for hackers
 Found in file sv.h
 
-=item SvNVX
+=item SvNVx
 
-Returns the raw value in the SV's NV slot, without checks or conversions.
-Only use when you are sure SvNOK is true. See also C<SvNV()>.
+Coerces the given SV to a double and returns it. Guarantees to evaluate
+sv only once. Use the more efficient C<SvNV> otherwise.
 
-	NV	SvNVX(SV* sv)
+	NV	SvNVx(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvNVx
+=item SvNVX
 
-Coerces the given SV to a double and returns it. Guarantees to evaluate
-sv only once. Use the more efficient C<SvNV> otherwise.
+Returns the raw value in the SV's NV slot, without checks or conversions.
+Only use when you are sure SvNOK is true. See also C<SvNV()>.
 
-	NV	SvNVx(SV* sv)
+	NV	SvNVX(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -3227,21 +3236,21 @@ Like C<SvPV_nolen>, but converts sv to utf8 first if necessary.
 =for hackers
 Found in file sv.h
 
-=item SvPVx
+=item SvPVX
 
-A version of C<SvPV> which guarantees to evaluate sv only once.
+Returns a pointer to the physical string in the SV.  The SV must contain a
+string.
 
-	char*	SvPVx(SV* sv, STRLEN len)
+	char*	SvPVX(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvPVX
+=item SvPVx
 
-Returns a pointer to the physical string in the SV.  The SV must contain a
-string.
+A version of C<SvPV> which guarantees to evaluate sv only once.
 
-	char*	SvPVX(SV* sv)
+	char*	SvPVx(SV* sv, STRLEN len)
 
 =for hackers
 Found in file sv.h
@@ -3279,6 +3288,15 @@ stringified form becoming C<SvPOK>.  Handles 'get' magic.
 =for hackers
 Found in file sv.h
 
+=item SvPV_nomg
+
+Like C<SvPV> but doesn't process magic.
+
+	char*	SvPV_nomg(SV* sv, STRLEN len)
+
+=for hackers
+Found in file sv.h
+
 =item SvREFCNT
 
 Returns the value of the object's reference count.
@@ -3480,6 +3498,16 @@ for a version which guarantees to evaluate sv only once.
 =for hackers
 Found in file sv.h
 
+=item SvUVx
+
+Coerces the given SV to an unsigned integer and returns it. Guarantees to
+evaluate sv only once. Use the more efficient C<SvUV> otherwise.
+
+	UV	SvUVx(SV* sv)
+
+=for hackers
+Found in file sv.h
+
 =item SvUVX
 
 Returns the raw value in the SV's UV slot, without checks or conversions.
@@ -3490,12 +3518,11 @@ Only use when you are sure SvIOK is true. See also C<SvUV()>.
 =for hackers
 Found in file sv.h
 
-=item SvUVx
+=item SvUV_nomg
 
-Coerces the given SV to an unsigned integer and returns it. Guarantees to
-evaluate sv only once. Use the more efficient C<SvUV> otherwise.
+Like C<SvUV> but doesn't process magic.
 
-	UV	SvUVx(SV* sv)
+	UV	SvUV_nomg(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -3540,12 +3567,13 @@ named after the PV if we're a string.
 =for hackers
 Found in file sv.c
 
-=item sv_2iv
+=item sv_2iv_flags
 
-Return the integer value of an SV, doing any necessary string conversion,
-magic etc. Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
+Return the integer value of an SV, doing any necessary string
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
 
-	IV	sv_2iv(SV* sv)
+	IV	sv_2iv_flags(SV* sv, I32 flags)
 
 =for hackers
 Found in file sv.c
@@ -3643,13 +3671,13 @@ use the macro wrapper C<SvPV_nolen(sv)> instead.
 =for hackers
 Found in file sv.c
 
-=item sv_2uv
+=item sv_2uv_flags
 
 Return the unsigned integer value of an SV, doing any necessary string
-conversion, magic etc. Normally used via the C<SvUV(sv)> and C<SvUVx(sv)>
-macros.
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
 
-	UV	sv_2uv(SV* sv)
+	UV	sv_2uv_flags(SV* sv, I32 flags)
 
 =for hackers
 Found in file sv.c
diff --git a/pp.c b/pp.c
index 7ebc7b807f..8898735d42 100644
--- a/pp.c
+++ b/pp.c
@@ -2204,11 +2204,11 @@ PP(pp_bit_and)
       if (SvGMAGICAL(right)) mg_get(right);
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	if (PL_op->op_private & HINT_INTEGER) {
-	  IV i = SvIV(left) & SvIV(right);
+	  IV i = SvIV_nomg(left) & SvIV_nomg(right);
 	  SETi(i);
 	}
 	else {
-	  UV u = SvUV(left) & SvUV(right);
+	  UV u = SvUV_nomg(left) & SvUV_nomg(right);
 	  SETu(u);
 	}
       }
@@ -2229,11 +2229,11 @@ PP(pp_bit_xor)
       if (SvGMAGICAL(right)) mg_get(right);
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	if (PL_op->op_private & HINT_INTEGER) {
-	  IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
+	  IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right);
 	  SETi(i);
 	}
 	else {
-	  UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
+	  UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right);
 	  SETu(u);
 	}
       }
@@ -2254,11 +2254,11 @@ PP(pp_bit_or)
       if (SvGMAGICAL(right)) mg_get(right);
       if (SvNIOKp(left) || SvNIOKp(right)) {
 	if (PL_op->op_private & HINT_INTEGER) {
-	  IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
+	  IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right);
 	  SETi(i);
 	}
 	else {
-	  UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
+	  UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right);
 	  SETu(u);
 	}
       }
@@ -2357,11 +2357,11 @@ PP(pp_complement)
 	  mg_get(sv);
       if (SvNIOKp(sv)) {
 	if (PL_op->op_private & HINT_INTEGER) {
-	  IV i = ~SvIV(sv);
+	  IV i = ~SvIV_nomg(sv);
 	  SETi(i);
 	}
 	else {
-	  UV u = ~SvUV(sv);
+	  UV u = ~SvUV_nomg(sv);
 	  SETu(u);
 	}
       }
@@ -2370,7 +2370,7 @@ PP(pp_complement)
 	register I32 anum;
 	STRLEN len;
 
-	SvSetSV(TARG, sv);
+	sv_setsv_nomg(TARG, sv);
 	tmps = (U8*)SvPV_force(TARG, len);
 	anum = len;
 	if (SvUTF8(TARG)) {
diff --git a/proto.h b/proto.h
index 359c9864fd..ee315bf863 100644
--- a/proto.h
+++ b/proto.h
@@ -667,14 +667,16 @@ PERL_CALLCONV void	Perl_sub_crush_depth(pTHX_ CV* cv);
 PERL_CALLCONV bool	Perl_sv_2bool(pTHX_ SV* sv);
 PERL_CALLCONV CV*	Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref);
 PERL_CALLCONV IO*	Perl_sv_2io(pTHX_ SV* sv);
-PERL_CALLCONV IV	Perl_sv_2iv(pTHX_ SV* sv);
+/* PERL_CALLCONV IV	sv_2iv(pTHX_ SV* sv); */
+PERL_CALLCONV IV	Perl_sv_2iv_flags(pTHX_ SV* sv, I32 flags);
 PERL_CALLCONV SV*	Perl_sv_2mortal(pTHX_ SV* sv);
 PERL_CALLCONV NV	Perl_sv_2nv(pTHX_ SV* sv);
 /* PERL_CALLCONV char*	sv_2pv(pTHX_ SV* sv, STRLEN* lp); */
 PERL_CALLCONV char*	Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp);
 PERL_CALLCONV char*	Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp);
 PERL_CALLCONV char*	Perl_sv_pvn_nomg(pTHX_ SV* sv, STRLEN* lp);
-PERL_CALLCONV UV	Perl_sv_2uv(pTHX_ SV* sv);
+/* PERL_CALLCONV UV	sv_2uv(pTHX_ SV* sv); */
+PERL_CALLCONV UV	Perl_sv_2uv_flags(pTHX_ SV* sv, I32 flags);
 PERL_CALLCONV IV	Perl_sv_iv(pTHX_ SV* sv);
 PERL_CALLCONV UV	Perl_sv_uv(pTHX_ SV* sv);
 PERL_CALLCONV NV	Perl_sv_nv(pTHX_ SV* sv);
diff --git a/sv.c b/sv.c
index db9490a346..6e64702b70 100644
--- a/sv.c
+++ b/sv.c
@@ -2039,22 +2039,34 @@ S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
 }
 #endif /* !NV_PRESERVES_UV*/
 
+/* sv_2iv() is now a macro using Perl_sv_2iv_flags();
+ * this function provided for binary compatibility only
+ */
+
+IV
+Perl_sv_2iv(pTHX_ register SV *sv)
+{
+    return sv_2iv_flags(sv, SV_GMAGIC);
+}
+
 /*
-=for apidoc sv_2iv
+=for apidoc sv_2iv_flags
 
-Return the integer value of an SV, doing any necessary string conversion,
-magic etc. Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
+Return the integer value of an SV, doing any necessary string
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
 
 =cut
 */
 
 IV
-Perl_sv_2iv(pTHX_ register SV *sv)
+Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
 {
     if (!sv)
 	return 0;
     if (SvGMAGICAL(sv)) {
-	mg_get(sv);
+	if (flags & SV_GMAGIC)
+	    mg_get(sv);
 	if (SvIOKp(sv))
 	    return SvIVX(sv);
 	if (SvNOKp(sv)) {
@@ -2336,23 +2348,34 @@ Perl_sv_2iv(pTHX_ register SV *sv)
     return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
 }
 
+/* sv_2uv() is now a macro using Perl_sv_2uv_flags();
+ * this function provided for binary compatibility only
+ */
+
+UV
+Perl_sv_2uv(pTHX_ register SV *sv)
+{
+    return sv_2uv_flags(sv, SV_GMAGIC);
+}
+
 /*
-=for apidoc sv_2uv
+=for apidoc sv_2uv_flags
 
 Return the unsigned integer value of an SV, doing any necessary string
-conversion, magic etc. Normally used via the C<SvUV(sv)> and C<SvUVx(sv)>
-macros.
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
 
 =cut
 */
 
 UV
-Perl_sv_2uv(pTHX_ register SV *sv)
+Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
 {
     if (!sv)
 	return 0;
     if (SvGMAGICAL(sv)) {
-	mg_get(sv);
+	if (flags & SV_GMAGIC)
+	    mg_get(sv);
 	if (SvIOKp(sv))
 	    return SvUVX(sv);
 	if (SvNOKp(sv))
diff --git a/sv.h b/sv.h
index b31cb14851..332a7f4b58 100644
--- a/sv.h
+++ b/sv.h
@@ -854,6 +854,9 @@ C<SvPVx> for a version which guarantees to evaluate sv only once.
 =for apidoc Am|char*|SvPVx|SV* sv|STRLEN len
 A version of C<SvPV> which guarantees to evaluate sv only once.
 
+=for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len
+Like C<SvPV> but doesn't process magic.
+
 =for apidoc Am|char*|SvPV_nolen|SV* sv
 Returns a pointer to the string in the SV, or a stringified form of
 the SV if the SV does not contain a string.  The SV may cache the
@@ -863,6 +866,9 @@ stringified form becoming C<SvPOK>.  Handles 'get' magic.
 Coerces the given SV to an integer and returns it. See  C<SvIVx> for a
 version which guarantees to evaluate sv only once.
 
+=for apidoc Am|IV|SvIV_nomg|SV* sv
+Like C<SvIV> but doesn't process magic.
+
 =for apidoc Am|IV|SvIVx|SV* sv
 Coerces the given SV to an integer and returns it. Guarantees to evaluate
 sv only once. Use the more efficient C<SvIV> otherwise.
@@ -879,6 +885,9 @@ sv only once. Use the more efficient C<SvNV> otherwise.
 Coerces the given SV to an unsigned integer and returns it.  See C<SvUVx>
 for a version which guarantees to evaluate sv only once.
 
+=for apidoc Am|UV|SvUV_nomg|SV* sv
+Like C<SvUV> but doesn't process magic.
+
 =for apidoc Am|UV|SvUVx|SV* sv
 Coerces the given SV to an unsigned integer and returns it. Guarantees to
 evaluate sv only once. Use the more efficient C<SvUV> otherwise.
@@ -942,6 +951,9 @@ scalar.
 #define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
 #define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv))
 
+#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
+#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
+
 /* ----*/
 
 #define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC)
@@ -1114,6 +1126,8 @@ scalar.
 #define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0)
 #define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC)
 #define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC)
+#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC)
+#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC)
 
 /* Should be named SvCatPVN_utf8_upgrade? */
 #define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv)	\
diff --git a/t/op/bop.t b/t/op/bop.t
index c433875aa8..d5315a82d1 100755
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -9,7 +9,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..44\n";
+print "1..143\n";
 
 # numerics
 print ((0xdead & 0xbeef) == 0x9ead ? "ok 1\n" : "not ok 1\n");
@@ -184,3 +184,149 @@ $neg1 = -1.0;
 print ((~ $neg1 == 0) ? "ok 43\n" : "not ok 43\n");
 $neg7 = -7.0;
 print ((~ $neg7 == 6) ? "ok 44\n" : "not ok 44\n");
+
+require "./test.pl";
+curr_test(45);
+
+# double magic tests
+
+sub TIESCALAR { bless { value => $_[1], orig => $_[1] } }
+sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] }
+sub FETCH { $_[0]{fetch}++; $_[0]{value} }
+sub stores { tied($_[0])->{value} = tied($_[0])->{orig};
+             delete(tied($_[0])->{store}) || 0 }
+sub fetches { delete(tied($_[0])->{fetch}) || 0 }
+
+# numeric double magic tests
+
+tie $x, "main", 1;
+tie $y, "main", 3;
+
+is(($x | $y), 3);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), 1);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), 2);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), 3);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), 1);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), 2);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~~$y, 3);
+is(fetches($y), 1);
+is(stores($y), 0);
+
+{ use integer;
+
+is(($x | $y), 3);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), 1);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), 2);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), 3);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), 1);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), 2);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~$y, -4);
+is(fetches($y), 1);
+is(stores($y), 0);
+
+} # end of use integer;
+
+# stringwise double magic tests
+
+tie $x, "main", "a";
+tie $y, "main", "c";
+
+is(($x | $y), ("a" | "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), ("a" & "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), ("a" ^ "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), ("a" | "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), ("a" & "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), ("a" ^ "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~~$y, "c");
+is(fetches($y), 1);
+is(stores($y), 0);