Author: coke
Date: Fri Aug 12 09:29:44 2005
New Revision: 8930
Modified:
trunk/languages/tcl/classes/tclfloat.pmc
trunk/languages/tcl/t/cmd_expr.t
Log:
tcl: use a precision of 12 when printing floats. change the expr tests to
reflect the new precision.
Modified: trunk/languages/tcl/classes/tclfloat.pmc
==============================================================================
--- trunk/languages/tcl/classes/tclfloat.pmc (original)
+++ trunk/languages/tcl/classes/tclfloat.pmc Fri Aug 12 09:29:44 2005
@@ -11,42 +11,47 @@
*/
#include "parrot/parrot.h"
+#include <assert.h>
pmclass TclFloat extends TclObject extends Float dynpmc group tcl_group {
STRING* get_string () {
- char* buff = mem_sys_allocate(80);
- int buflen,checklen;
+ UINTVAL buflen;
int check_flag;
+ STRING * buff;
+ STRING * dot;
+ STRING * dot_zero;
+
+ buff = Parrot_sprintf_c(INTERP, "%.12vg",PMC_num_val(SELF));
+
+ /*
+ * this sprintf variant will return something that looks like
+ * an int if it can : if we have no decimal point then tack on
+ * on and return
+ */
+ dot = string_from_cstring(INTERP,".",1);
+
+ if (string_str_index(INTERP,buff,dot,0) == -1 ) {
+ dot_zero = string_from_cstring(INTERP,".0",2);
+ buff = string_append(INTERP, buff, dot_zero,0);
+ return buff;
+ }
- STRING* s;
-#ifdef HAS_SNPRINTF
- snprintf(buff,80,FLOATVAL_FMT,PMC_num_val(SELF));
-#else
- sprintf(buff,FLOATVAL_FMT,PMC_num_val(SELF)); /* XXX buffer overflow!
*/
-#endif
- check_flag = 1;
- checklen = buflen = strlen(buff);
- while (check_flag && buflen) {
- if (buff[buflen-1] == 48) { /* 0 */
+ check_flag = 0;
+ buflen = string_length(INTERP,buff);
+ while (buflen) {
+ if (string_index(INTERP,buff,buflen-1) == '0') {
buflen--;
- } else {
- check_flag = 0;
+ check_flag = 1;
+ } else {
+ break;
}
}
- /* if the last entry is now a ".", then add one zero back in. */
- if (buff[buflen-1] == 46) {
- buflen++;
- }
- /* paranoid? */
- if (buflen > checklen) {
- buflen = checklen;
- }
- buff[buflen] = 0; /* should this be necessary? */
- s = string_make(INTERP,buff,buflen,"iso-8859-1",0);
- mem_sys_free(buff);
- return s;
+ /* truncate the string */
+ buff->strlen = buflen;
+ buff->bufused = buflen;
+ return buff;
}
}
Modified: trunk/languages/tcl/t/cmd_expr.t
==============================================================================
--- trunk/languages/tcl/t/cmd_expr.t (original)
+++ trunk/languages/tcl/t/cmd_expr.t Fri Aug 12 09:29:44 2005
@@ -151,13 +151,6 @@ TCL
3
OUT
-#
-# now, functions - the accuracy and int vs. float nature here is
-# still an issue - we're testing to make sure that the functions
-# exist, basically. better tests will need to be written (or the tcl
-# test suite used.) (XXX)
-#
-
language_output_is("tcl",<<TCL,<<OUT,"abs");
puts [expr abs(1-2)]
TCL
@@ -167,61 +160,61 @@ OUT
language_output_is("tcl",<<TCL,<<OUT,"acos");
puts [expr acos(0)]
TCL
-1.570796
+1.57079632679
OUT
language_output_is("tcl",<<TCL,<<OUT,"asin");
puts [expr asin(1)]
TCL
-1.570796
+1.57079632679
OUT
language_output_is("tcl",<<TCL,<<OUT,"atan");
puts [expr atan(1)]
TCL
-0.785398
+0.785398163397
OUT
language_output_is("tcl",<<TCL,<<OUT,"cos");
puts [expr cos(1)]
TCL
-0.540302
+0.540302305868
OUT
language_output_is("tcl",<<TCL,<<OUT,"cosh");
puts [expr cosh(1)]
TCL
-1.543081
+1.54308063482
OUT
language_output_is("tcl",<<TCL,<<OUT,"exp");
puts [expr exp(1)]
TCL
-2.718282
+2.71828182846
OUT
language_output_is("tcl",<<TCL,<<OUT,"log");
puts [expr log(32)]
TCL
-3.465736
+3.4657359028
OUT
language_output_is("tcl",<<TCL,<<OUT,"log10");
puts [expr log10(32)]
TCL
-1.50515
+1.50514997832
OUT
language_output_is("tcl",<<TCL,<<OUT,"sin");
puts [expr sin(1)]
TCL
-0.841471
+0.841470984808
OUT
language_output_is("tcl",<<TCL,<<OUT,"sinh");
puts [expr sinh(1)]
TCL
-1.175201
+1.17520119364
OUT
language_output_is("tcl",<<TCL,<<OUT,"sqrt");
@@ -233,13 +226,13 @@ OUT
language_output_is("tcl",<<TCL,<<OUT,"tan");
puts [expr tan(1)]
TCL
-1.557408
+1.55740772465
OUT
language_output_is("tcl",<<TCL,<<OUT,"tanh");
puts [expr tanh(1)]
TCL
-0.761594
+0.761594155956
OUT
# misc.
@@ -265,7 +258,7 @@ TCL
0.333333333333
OUT
-language_output_is("tcl",<<'TCL',<<'OUT',"int vs. float");
+language_output_is("tcl",<<'TCL',<<'OUT',"braced operands.");
set n 1
puts [expr {$n * 1}]
TCL
