cvsuser 04/03/18 00:57:30
Modified: imcc pbc.c
src objects.c string.c
t/op comp.t
t/pmc objects.t
Log:
Bug #27690 Numeric comparison bug (Simon Glover)
- fix string_to_num
- use that inside imcc/pbc.c
Patches courtesy of Skip Livingston
- Fix subclass anon bug #27715 (Simon Glover)
Revision Changes Path
1.69 +3 -1 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -w -r1.68 -r1.69
--- pbc.c 15 Mar 2004 13:16:08 -0000 1.68
+++ pbc.c 18 Mar 2004 08:56:58 -0000 1.69
@@ -591,13 +591,15 @@
add_const_num(struct Parrot_Interp *interpreter, char *buf)
{
int k;
+ STRING *s;
k = PDB_extend_const_table(interpreter);
interpreter->code->const_table->constants[k]->type =
PFC_NUMBER;
+ s = string_from_cstring(interpreter, buf, 0);
interpreter->code->const_table->constants[k]->u.number =
- (FLOATVAL)atof(buf);
+ string_to_num(s);
return k;
}
1.61 +4 -4 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -w -r1.60 -r1.61
--- objects.c 17 Mar 2004 08:54:41 -0000 1.60
+++ objects.c 18 Mar 2004 08:57:18 -0000 1.61
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.60 2004/03/17 08:54:41 leo Exp $
+$Id: objects.c,v 1.61 2004/03/18 08:57:18 leo Exp $
=head1 NAME
@@ -266,10 +266,10 @@
child_class_name, child_class);
}
else {
+ child_class_name = string_make(interpreter,
+ "\0\0anonymous", 11, NULL, 0, NULL);
VTABLE_set_string_native(interpreter, classname_pmc,
- string_make(interpreter,
- "\0\0anonymous",
- 11, NULL, 0, NULL));
+ child_class_name );
}
set_attrib_num(child_class_array, PCD_CLASS_NAME, classname_pmc);
1.177 +28 -4 parrot/src/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/src/string.c,v
retrieving revision 1.176
retrieving revision 1.177
diff -u -w -r1.176 -r1.177
--- string.c 6 Mar 2004 07:35:29 -0000 1.176
+++ string.c 18 Mar 2004 08:57:18 -0000 1.177
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: string.c,v 1.176 2004/03/06 07:35:29 leo Exp $
+$Id: string.c,v 1.177 2004/03/18 08:57:18 leo Exp $
=head1 NAME
@@ -1836,9 +1836,10 @@
int exp_sign = 0;
INTVAL in_exp = 0;
INTVAL in_number = 0;
- FLOATVAL exponent = 0;
+ INTVAL exponent = 0;
INTVAL fake_exponent = 0;
INTVAL digit_family = 0;
+ FLOATVAL exp_log=10.0, exp_val=1.0;
while (start < end) {
UINTVAL c = s->encoding->decode(start);
@@ -1906,7 +1907,30 @@
exponent = fake_exponent + exponent * exp_sign;
- f = f * sign * pow(10.0, exponent); /* ugly, oh yeah */
+ if(exponent < 0) {
+ exponent = -exponent;
+ exp_sign=-1;
+ }
+
+ for (;;) {
+ if (exponent & 1) {
+ exp_val *= exp_log;
+ exponent--;
+ }
+ if (!exponent)
+ break;
+ exp_log *= exp_log;
+ exponent >>= 1;
+ }
+
+ if(exp_sign < 0)
+ f /= exp_val;
+ else
+ f *= exp_val;
+
+
+ if(sign < 0)
+ f = -f;
}
return f;
1.6 +15 -2 parrot/t/op/comp.t
Index: comp.t
===================================================================
RCS file: /cvs/public/parrot/t/op/comp.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- comp.t 8 Mar 2004 00:19:58 -0000 1.5
+++ comp.t 18 Mar 2004 08:57:27 -0000 1.6
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: comp.t,v 1.5 2004/03/08 00:19:58 chromatic Exp $
+# $Id: comp.t,v 1.6 2004/03/18 08:57:27 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 7;
+use Parrot::Test tests => 8;
# some of these were failing with JIT/i386
@@ -180,6 +180,19 @@
0
-1
1
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "eq_num");
+ new P0, .PerlNum
+ set P0, -1.2
+ new P1, .PerlString
+ set P1, "-1.2"
+ eq_num P0, P1, OK
+ print "not "
+OK: print "ok\n"
+ end
+CODE
+ok
OUTPUT
1;
1.37 +15 -5 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -w -r1.36 -r1.37
--- objects.t 17 Mar 2004 19:27:33 -0000 1.36
+++ objects.t 18 Mar 2004 08:57:30 -0000 1.37
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: objects.t,v 1.36 2004/03/17 19:27:33 scog Exp $
+# $Id: objects.t,v 1.37 2004/03/18 08:57:30 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 32;
+use Parrot::Test tests => 33;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
@@ -1010,5 +1010,15 @@
/Class doesn't exist/
OUTPUT
-1;
+output_like(<<'CODE', <<'OUTPUT', "anon. subclass classname");
+ newclass P0, "City"
+ subclass P1, P0
+ classname S0, P1
+ print S0
+ print "\n"
+ end
+CODE
+/anonymous/
+OUTPUT
+
