1
0
mirror of https://git.FreeBSD.org/ports.git synced 2024-12-18 03:46:03 +00:00

Rely on critcl port to provide compiled implementations of the

modules, where available.

PR:		195863
Approved by:	maintainer (blanket)
This commit is contained in:
Mikhail Teterin 2015-05-27 17:19:32 +00:00
parent 1772b156cd
commit 6e626117c9
Notes: svn2git 2021-03-31 03:12:20 +00:00
svn path=/head/; revision=387637
5 changed files with 294 additions and 7 deletions

View File

@ -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 <bsd.port.mk>

View File

@ -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
}

View File

@ -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}

View File

@ -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.

View File

@ -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