languages/tcl/src/pmc/tclfloat.pmc

   1 /* TclFloat.pmc
   2  *  Copyright (C) 2001-2003, The Perl Foundation.
   3  *  SVN Info
   4  *     $Id$
   5  *  Overview:
   6  *     These are the vtable functions for the TclFloat base class
   7  *  Data Structure and Algorithms:
   8  *  History:
   9  *  Notes:
  10  *  References:
  11  */
  12
  13 #include "parrot/embed.h"
  14 #include <assert.h>
  15
  16 pmclass TclFloat
  17     dynpmc
  18     extends TclObject
  19     extends Float
  20     does    float
  21     group   tcl_group
  22     hll     Tcl
  23     maps    Float
  24 {
  25
  26     STRING* get_string() {
  27         UINTVAL buflen;
  28         int check_flag;
  29         STRING *buff;
  30         STRING *dot;
  31         STRING *e;
  32         STRING *dot_zero;
  33         STRING *_precision = string_from_cstring(INTERP, "$tcl_precision", 14);
  34         STRING *_tcl = string_from_cstring(INTERP, "tcl", 3);
  35
  36         PMC * const root_ns = INTERP->root_namespace;
  37         PMC * const hll_ns  = VTABLE_get_pmc_keyed_str(INTERP, root_ns, _tcl);
  38         PMC * precision_pmc =
  39             Parrot_find_global_op(INTERP, hll_ns, _precision, NULL);
  40         INTVAL precision = VTABLE_get_integer(INTERP, precision_pmc);
  41
  42         if (precision == 0)
  43             precision = 16; /* RT#40639: hack to approximate right output.*/
  44
  45         buff  = Parrot_sprintf_c(INTERP, "%.*vg", precision, PMC_num_val(SELF));
  46
  47         /*
  48          * this sprintf variant will return something that looks like
  49          * an int if it can : if we have no decimal point then tack on
  50          * on and return
  51          */
  52         dot = string_from_cstring(INTERP, ".", 1);
  53         e   = string_from_cstring(INTERP, "e", 1);
  54
  55         if (string_str_index(INTERP, buff, dot, 0) == -1
  56          && string_str_index(INTERP, buff, e, 0) == -1) {
  57             dot_zero = string_from_cstring(INTERP, ".0", 2);
  58             buff = string_append(INTERP, buff, dot_zero);
  59             return buff;
  60         }
  61
  62         check_flag = 0;
  63         buflen = string_length(INTERP, buff);
  64         while (buflen) {
  65                if (string_index(INTERP, buff, buflen-1) == '0') {
  66                        buflen--;
  67                        check_flag = 1;
  68                }
  69                else {
  70                        break;
  71                }
  72         }
  73
  74         /* truncate the string */
  75         buff->strlen = buflen;
  76         buff->bufused = buflen;
  77         return buff;
  78     }
  79
  80 }
  81
  82 /*
  83  * Local variables:
  84  *   c-file-style: "parrot"
  85  * End:
  86  * vim: expandtab shiftwidth=4:
  87  */