cvsuser 03/10/22 11:43:24
Modified: classes perlint.pmc
t/pmc perlint.t
Log:
fix logical or of PerlInts, #24267 reported and test case by Simon Glover
Revision Changes Path
1.49 +17 -9 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -w -r1.48 -r1.49
--- perlint.pmc 20 Oct 2003 21:01:30 -0000 1.48
+++ perlint.pmc 22 Oct 2003 18:43:22 -0000 1.49
@@ -1,7 +1,7 @@
/* perlint.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlint.pmc,v 1.48 2003/10/20 21:01:30 scog Exp $
+ * $Id: perlint.pmc,v 1.49 2003/10/22 18:43:22 leo Exp $
* Overview:
* These are the vtable functions for the PerlInt base class
* Data Structure and Algorithms:
@@ -445,23 +445,31 @@
void logical_or (PMC* value, PMC* dest) {
VTABLE_set_integer_native(INTERP, dest,
- SELF->cache.int_val ||
- VTABLE_get_bool(INTERP, value)
+ SELF->cache.int_val ? SELF->cache.int_val :
+ VTABLE_get_integer(INTERP, value)
);
}
void logical_and (PMC* value, PMC* dest) {
VTABLE_set_integer_native(INTERP, dest,
- SELF->cache.int_val &&
- VTABLE_get_bool(INTERP, value)
+ !SELF->cache.int_val ? SELF->cache.int_val :
+ VTABLE_get_integer(INTERP, value)
);
}
void logical_xor (PMC* value, PMC* dest) {
- VTABLE_set_integer_native(INTERP, dest,
- ( SELF->cache.int_val ? 1 : 0 ) ^
- VTABLE_get_bool(INTERP, value)
- );
+ INTVAL left_truth, right_truth, res;
+
+ left_truth = SELF->cache.int_val;
+ right_truth = VTABLE_get_integer(INTERP, value);
+ if ((left_truth && right_truth) || (!left_truth && !right_truth))
+ res = 0;
+ else if (left_truth)
+ res = left_truth;
+ else
+ res = right_truth;
+
+ VTABLE_set_integer_native(INTERP, dest, res);
}
void logical_not (PMC* value) {
1.12 +20 -1 parrot/t/pmc/perlint.t
Index: perlint.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlint.t,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- perlint.t 20 Oct 2003 21:01:32 -0000 1.11
+++ perlint.t 22 Oct 2003 18:43:24 -0000 1.12
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 21;
+use Parrot::Test tests => 22;
use Parrot::PMC '%pmc_types';
my $perlint = $pmc_types{'PerlInt'};
my $ok = '"ok 1\n"';
@@ -637,4 +637,23 @@
4123
4123
4143
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "or_p_p_p");
+ new P0, .PerlInt
+ new P1, .PerlInt
+ new P2, .PerlInt
+ set P0, 10
+ set P1, 20
+ or P2, P1, P0
+ print P2
+ print "\n"
+ set P1, 0
+ or P2, P1, P0
+ print P2
+ print "\n"
+ end
+CODE
+20
+10
OUTPUT
