From 6e626117c9cb890497e931cbfe79b978ae8d9a5e Mon Sep 17 00:00:00 2001 From: Mikhail Teterin Date: Wed, 27 May 2015 17:19:32 +0000 Subject: [PATCH] Rely on critcl port to provide compiled implementations of the modules, where available. PR: 195863 Approved by: maintainer (blanket) --- devel/tcllib/Makefile | 17 ++- devel/tcllib/files/patch-jpeg | 12 ++ devel/tcllib/files/patch-json | 250 +++++++++++++++++++++++++++++++++ devel/tcllib/files/patch-tests | 18 +++ devel/tcllib/pkg-plist | 4 + 5 files changed, 294 insertions(+), 7 deletions(-) create mode 100644 devel/tcllib/files/patch-jpeg create mode 100644 devel/tcllib/files/patch-json create mode 100644 devel/tcllib/files/patch-tests diff --git a/devel/tcllib/Makefile b/devel/tcllib/Makefile index c05b1b8797c9..ee9360b96105 100644 --- a/devel/tcllib/Makefile +++ b/devel/tcllib/Makefile @@ -3,6 +3,7 @@ PORTNAME= tcllib PORTVERSION= 1.17 +PORTREVISION= 1 CATEGORIES= devel tcl MAINTAINER= tcltk@FreeBSD.org @@ -13,6 +14,8 @@ LICENSE_NAME= Tcl/Tk License LICENSE_FILE= ${WRKSRC}/license.terms LICENSE_PERMS= dist-mirror dist-sell pkg-mirror pkg-sell auto-accept +BUILD_DEPENDS= critcl:${PORTSDIR}/devel/critcl + OPTIONS_DEFINE= DOCS MANPAGES USE_GITHUB= yes @@ -22,9 +25,11 @@ GH_TAGNAME= ${PORTNAME}_${PORTVERSION:S/./_/} USES+= tcl GNU_CONFIGURE= yes CONFIGURE_ENV+= ac_cv_path_tclsh="${TCLSH}" -ALL_TARGET= all +ALL_TARGET= critcl MAKE_ENV+= LANG=C PORTDOCS= * +REINPLACE_ARGS= -i'""' +PLIST_SUB+= BINARCH=${OPSYS:tl}-${ARCH:S/i386/ix86/} INSTALL_ARGS= -pkgs -pkg-path ${STAGEDIR}${PREFIX}/lib/tcllib \ -apps -app-path ${STAGEDIR}${PREFIX}/bin \ @@ -71,11 +76,6 @@ post-patch: ${WRKSRC}/modules/doctools/tests/text/04 > ${WRKSRC}/modules/doctools/tests/text/04.new ${MV} ${WRKSRC}/modules/doctools/tests/text/04.new ${WRKSRC}/modules/doctools/tests/text/04 # -# .orig files confuse the pt module test suite and eventually get -# installed -# - ${FIND} ${WRKSRC} -name "*.orig" -delete -# # man pages have the .tcllib suffix, so there's no need to have a # tcllib_ prefix too # @@ -97,11 +97,14 @@ post-patch: for man in `${FIND} . -name "*.n"`; do \ ${MV} $$man `echo $$man | ${SED} -e 's|n$$|tcllib.n|'`; \ done + cd ${WRKSRC}/modules/json/c && ${YACC} -b json json.y do-install: cd ${WRKSRC} && ${TCLSH} ./installer.tcl ${INSTALL_ARGS} + ${RM} ${WRKSRC}/modules/tcllibc/license.terms + ${CP} -Rp ${WRKSRC}/modules/tcllibc ${STAGEDIR}${PREFIX}/lib/tcllib/ -regression-test: build +test check xregression-test: build cd ${WRKSRC} && ${SETENV} LANG=C LC_ALL=C DISPLAY= ${MAKE} test .include diff --git a/devel/tcllib/files/patch-jpeg b/devel/tcllib/files/patch-jpeg new file mode 100644 index 000000000000..f7472f8b61b4 --- /dev/null +++ b/devel/tcllib/files/patch-jpeg @@ -0,0 +1,12 @@ +--- modules/jpeg/jpeg.tcl 2014-02-11 14:04:18.000000000 -0500 ++++ modules/jpeg/jpeg.tcl 2014-12-09 00:28:21.000000000 -0500 +@@ -364,5 +364,8 @@ + set fh [openJFIF $file] + set r [catch {getExifFromChannel $fh $type} err] +- close $fh ++ if {$err != ""} { ++ # If err is empty, the file is closed already ++ close $fh ++ } + return -code $r $err + } 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 ++#include + #include + #include + #include + #include + #include ++#if TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 4 ++#define USE_DICT ++#endif + + #include + + #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} diff --git a/devel/tcllib/files/patch-tests b/devel/tcllib/files/patch-tests new file mode 100644 index 000000000000..3e6aaa8c3def --- /dev/null +++ b/devel/tcllib/files/patch-tests @@ -0,0 +1,18 @@ +--- modules/clock/iso8601.test 2014-02-11 14:04:18.000000000 -0500 ++++ modules/clock/iso8601.test 2014-12-09 00:12:22.000000000 -0500 +@@ -27,5 +27,5 @@ + test clock-iso8601-1.1 {parse_date, bad option} -body { + clock::iso8601 parse_date 1994-11-05 -foo x +-} -returnCodes error -result {bad switch "-foo", must be -base, -format, -gmt, -locale or -timezone} ++} -returnCodes error -match regexp -result {bad (option|switch) "-foo", must be -base, -format, -gmt, -locale or -timezone} + + # NOTE: While listed as legal, -format is NOT. This is because the +--- modules/struct/sets.test 2014-02-11 14:04:18.000000000 -0500 ++++ modules/struct/sets.test 2014-12-09 01:39:00.000000000 -0500 +@@ -87,5 +87,5 @@ + } + tcl { +- if {[package vsatisfies [package present Tcl] 8.5]} { ++ if {$tcl_version == 8.5} { + # In 8.5 head the alias itself is reported, not what it + # resolved to. diff --git a/devel/tcllib/pkg-plist b/devel/tcllib/pkg-plist index 60fdd5746c60..66932c9430af 100644 --- a/devel/tcllib/pkg-plist +++ b/devel/tcllib/pkg-plist @@ -554,6 +554,10 @@ lib/tcllib/struct/tree_c.tcl lib/tcllib/struct/tree_tcl.tcl lib/tcllib/tar/pkgIndex.tcl lib/tcllib/tar/tar.tcl +lib/tcllib/tcllibc/critcl-rt.tcl +lib/tcllib/tcllibc/%%BINARCH%%/tcllibc.so +lib/tcllib/tcllibc/pkgIndex.tcl +lib/tcllib/tcllibc/teapot.txt lib/tcllib/tepam/pkgIndex.tcl lib/tcllib/tepam/tepam.tcl lib/tcllib/tepam/tepam_doc_gen.tcl