diff options
Diffstat (limited to 'devel/tcllib/files/patch-json')
| -rw-r--r-- | devel/tcllib/files/patch-json | 250 |
1 files changed, 250 insertions, 0 deletions
diff --git a/devel/tcllib/files/patch-json b/devel/tcllib/files/patch-json new file mode 100644 index 000000000000..ebef11c60cf8 --- /dev/null +++ b/devel/tcllib/files/patch-json @@ -0,0 +1,250 @@ +--- modules/json/c/json.y ++++ modules/json/c/json.y +@@ -3,26 +3,32 @@ + * Mikhail. + */ + + %{ + #include <tcl.h> ++#include <errno.h> + #include <ctype.h> + #include <math.h> + #include <string.h> + #include <stdlib.h> + #include <assert.h> ++#if TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 4 ++#define USE_DICT ++#endif + + #include <json_y.h> + + #define TOKEN(tok) TRACE (("TOKEN %s\n", tok)) + #define TOKEN1(tok) TRACE (("TOKEN %s (%s)\n", tok, Tcl_GetString(context->obj))) + #define REDUCE(rule) TRACE (("REDUCE %s\n", rule)) + +-#define TRUE_O (Tcl_NewStringObj("true", 4)) +-#define FALSE_O (Tcl_NewStringObj("false", 5)) +-#define NULL_O (Tcl_NewStringObj("null", 4)) ++#define TRUE_O staticobj(TRUEO) ++#define FALSE_O staticobj(FALSEO) ++#define NULL_O staticobj(NULLO) + ++enum constants { FALSEO, TRUEO, NULLO, NUMCONSTANTS }; ++static Tcl_Obj * staticobj(enum constants); + static void jsonerror(struct context *, const char *); + static int jsonlexp(struct context *context); + + #define YYPARSE_PARAM_TYPE void * + #define YYPARSE_PARAM context +@@ -105,18 +111,27 @@ + } + ; + + members : member + { ++#ifdef USE_DICT ++ $$ = Tcl_NewDictObj(); ++ Tcl_DictObjPut(NULL, $$, $1.key, $1.val); ++#else + $$ = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(NULL, $$, $1.key); + Tcl_ListObjAppendElement(NULL, $$, $1.val); ++#endif + } + | members ',' member + { ++#ifdef USE_DICT ++ Tcl_DictObjPut(NULL, $1, $3.key, $3.val); ++#else + Tcl_ListObjAppendElement(NULL, $1, $3.key); + Tcl_ListObjAppendElement(NULL, $1, $3.val); ++#endif + $$ = $1; + } + ; + + member : string ':' value +@@ -177,10 +192,69 @@ + continue; + } + break; + } + } ++ ++/* ++ * JSON has 3 string-literals: "null", "true", and "false". Instead of ++ * creating a NEW Tcl-object EACH TIME such literal is encountered, we ++ * return the reference to the first such object created (and bump its ++ * reference-count to prevent memory errors). ++ */ ++Tcl_Obj * ++staticobj(enum constants constant) ++{ ++ static Tcl_Obj *objects[NUMCONSTANTS]; ++ Tcl_Obj **p; ++ ++ assert(constant >= 0 && constant < NUMCONSTANTS); ++ p = objects + constant; ++ if (*p == NULL) { ++ /* ++ * This is the first time we were asked for an object for ++ * this constant. Create it to the best of our ability. ++ * ++ * Using the trick below, rather than the usual ++ * Tcl_NewStringObj(), avoids creation of a COPY ++ * of the string "null". Such copying is a waste, ++ * if the object itself is never to be freed... ++ */ ++ *p = Tcl_NewObj(); ++ switch (constant) { ++ case NULLO: ++ (*p)->bytes = (void *)"null"; ++ (*p)->length = 4; ++ break; ++ case TRUEO: ++ /* ++ * A boolean-object's default string representation is ++ * "0" or "1", but we'd like the fancier "false" and ++ * "true" for our objects to better match the ++ * expectations of JSON-users. ++ */ ++ Tcl_SetBooleanObj(*p, 1); ++ (*p)->bytes = (void *)"true"; ++ (*p)->length = 4; ++ break; ++ case FALSEO: ++ Tcl_SetBooleanObj(*p, 0); ++ (*p)->bytes = (void *)"false"; ++ (*p)->length = 5; ++ break; ++ default: ++ Tcl_Panic("Internal error in %s:%d unknown constant %d", ++ __FILE__, __LINE__, (int)constant); ++ } ++ } ++ /* ++ * Increase the ref-count so nothing ever attempts to free ++ * neither the static object we are returning, nor its bytes. ++ */ ++ Tcl_IncrRefCount(*p); ++ return *p; ++} + + static int + jsonlexp(struct context *context) + { + const char *bp = NULL; +@@ -191,10 +265,17 @@ + enum { + PLAIN = 0x0000ff00, + INSTR = 0x00ff0000 + } lstate; + double d; ++ int i; ++ long l; ++ long long ll; ++ Tcl_WideInt wi; ++#ifdef USE_BIG_NUM ++ mp_int mpi; ++#endif + char *end; + const char *p; + int initialized = 0; + + /* +@@ -343,32 +424,63 @@ + yyerror("Escape character outside of string"); + TOKEN ("escape error"); + return -1; + } + ++ context->obj = NULL; + /* + * We already considered the null, true, and false + * above, so it can only be a number now. +- * +- * NOTE: At this point we do not care about double +- * versus integer, nor about the possible integer +- * range. We generate a plain string Tcl_Obj and leave +- * it to the user of the generated structure to +- * convert to a number when actually needed. This +- * defered conversion also ensures that the Tcl and +- * platform we are building against does not matter +- * regarding integer range, only the abilities of the +- * Tcl at runtime. + */ +- ++ errno = 0; + d = strtod(context->text, &end); +- if (end == context->text) +- goto bareword; /* Nothing parsed */ +- +- context->obj = Tcl_NewStringObj (context->text, +- end - context->text); +- ++ if (end == context->text || isnan(d) || isinf(d)) ++ goto bareword; /* Nothing parsed */ ++ if (context->text[0] == '0' && context->text[1] != '.') { ++ yyerror("Leading zeros aren't allowed in JSON"); ++ TOKEN("Leading zero error"); ++ return -1; ++ } ++ if (errno == ERANGE) { ++ /* Too large. Let TCL core deal with it */ ++ goto donewithnumber; ++ } ++ /* See, if there was anything other than digit there: */ ++ for (p = context->text; p != end; p++) { ++ if ((*p >= '0' && *p <= '9') || *p == '+' || *p == '-') ++ continue; ++ context->obj = Tcl_NewDoubleObj(d); ++ goto donewithnumber; ++ } ++ /* Didn't find any non-digits, must be an integer: */ ++ errno = 0; ++ ll = strtoll(context->text, &end, 10); ++ if (errno == ERANGE) { ++ /* Too large. Let TCL core deal with it */ ++ goto donewithnumber; ++ } ++ /* Find the right integer-type for this number */ ++ i = ll; /* int ? */ ++ if (i == ll) { ++ context->obj = Tcl_NewIntObj(i); ++ goto donewithnumber; ++ } ++ l = ll; /* long ? */ ++ if (l == ll) { ++ context->obj = Tcl_NewLongObj(l); ++ goto donewithnumber; ++ } ++ wi = ll; /* Tcl_WideInt */ ++ if (wi == ll) { ++ context->obj = Tcl_NewWideIntObj(wi); ++ goto donewithnumber; ++ } ++ donewithnumber: ++ if (context->obj == NULL) { ++ context->obj = Tcl_NewStringObj(context->text, ++ end - context->text); ++ } + context->remaining -= (end - context->text); + context->text = end; + TOKEN1 ("CONSTANT"); + return CONSTANT; + } + +--- modules/json/tests/numbers.json ++++ modules/json/tests/numbers.json +@@ -0,0 +1,6 @@ ++{"numbers": { ++ "int" : 123, ++ "long" : 1234567890123456789, ++ "bigint": 12345678901234567890123456789012345678901234567890123456789 ++} ++} + +--- modules/json/tests/numbers.result ++++ modules/json/tests/numbers.result +@@ -0,0 +1,1 @@ ++numbers {int 123 long 1234567890123456789 bigint 12345678901234567890123456789012345678901234567890123456789} |