diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2016-11-25 15:06:13 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2016-11-25 15:06:13 (GMT) |
commit | 889b8febfba9a5853a367eaf01fa14b4040087d7 (patch) | |
tree | ac31caa64067eb47d063456c7a53d6eeadd09f5a /generic | |
parent | bd4ade16893719f146b31f467f5b1cbd2d7a393c (diff) | |
parent | 7b4af51ed2c67661856796cc6669052b86bda825 (diff) | |
download | tcl-889b8febfba9a5853a367eaf01fa14b4040087d7.zip tcl-889b8febfba9a5853a367eaf01fa14b4040087d7.tar.gz tcl-889b8febfba9a5853a367eaf01fa14b4040087d7.tar.bz2 |
Merge trunk.
Implementation looks complete. Still missing: test-cases and documentation.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/regc_lex.c | 6 | ||||
-rw-r--r-- | generic/regc_locale.c | 2 | ||||
-rw-r--r-- | generic/regc_nfa.c | 4 | ||||
-rw-r--r-- | generic/regcomp.c | 12 | ||||
-rw-r--r-- | generic/regcustom.h | 6 | ||||
-rw-r--r-- | generic/regexec.c | 4 | ||||
-rw-r--r-- | generic/regguts.h | 21 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 18 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 1 | ||||
-rw-r--r-- | generic/tclHash.c | 4 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 1 | ||||
-rw-r--r-- | generic/tclInt.decls | 2 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 5 | ||||
-rw-r--r-- | generic/tclLoad.c | 27 | ||||
-rw-r--r-- | generic/tclPkg.c | 48 | ||||
-rw-r--r-- | generic/tclRegexp.c | 13 |
16 files changed, 100 insertions, 74 deletions
diff --git a/generic/regc_lex.c b/generic/regc_lex.c index affcb48..4c8f15f 100644 --- a/generic/regc_lex.c +++ b/generic/regc_lex.c @@ -457,7 +457,7 @@ next( if (ATEOS()) { FAILW(REG_EESCAPE); } - (DISCARD)lexescape(v); + (void)lexescape(v); switch (v->nexttype) { /* not all escapes okay here */ case PLAIN: return 1; @@ -716,7 +716,7 @@ next( } RETV(PLAIN, *v->now++); } - (DISCARD)lexescape(v); + (void)lexescape(v); if (ISERR()) { FAILW(REG_EESCAPE); } @@ -1143,7 +1143,7 @@ skip( /* - newline - return the chr for a newline * This helps confine use of CHR to this source file. - ^ static chr newline(NOPARMS); + ^ static chr newline(void); */ static chr newline(void) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index a6958fe..ab3b7f1 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -1227,7 +1227,7 @@ cmp( const chr *x, const chr *y, /* strings to compare */ size_t len) /* exact length of comparison */ { - return memcmp(VS(x), VS(y), len*sizeof(chr)); + return memcmp((void*)(x), (void*)(y), len*sizeof(chr)); } /* diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index 088c6c0..240fcfe 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -843,7 +843,7 @@ moveins( /* - copyins - copy in arcs of a state to another state - ^ static VOID copyins(struct nfa *, struct state *, struct state *, int); + ^ static void copyins(struct nfa *, struct state *, struct state *, int); */ static void copyins( @@ -1100,7 +1100,7 @@ moveouts( /* - copyouts - copy out arcs of a state to another state - ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int); + ^ static void copyouts(struct nfa *, struct state *, struct state *, int); */ static void copyouts( diff --git a/generic/regcomp.c b/generic/regcomp.c index 211cd70..58d55fb 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -82,7 +82,7 @@ static int lexescape(struct vars *); static int lexdigits(struct vars *, int, int, int); static int brenext(struct vars *, pchr); static void skip(struct vars *); -static chr newline(NOPARMS); +static chr newline(void); static chr chrnamed(struct vars *, const chr *, const chr *, pchr); /* === regc_color.c === */ static void initcm(struct vars *, struct colormap *); @@ -341,13 +341,13 @@ compile( re->re_info = 0; /* bits get set during parse */ re->re_csize = sizeof(chr); re->re_guts = NULL; - re->re_fns = VS(&functions); + re->re_fns = (void*)(&functions); /* * More complex setup, malloced things. */ - re->re_guts = VS(MALLOC(sizeof(struct guts))); + re->re_guts = (void*)(MALLOC(sizeof(struct guts))); if (re->re_guts == NULL) { return freev(v, REG_ESPACE); } @@ -434,7 +434,7 @@ compile( * Can sacrifice main NFA now, so use it as work area. */ - (DISCARD) optimize(v->nfa, debug); + (void) optimize(v->nfa, debug); CNOERR(); makesearch(v, v->nfa); CNOERR(); @@ -1920,10 +1920,10 @@ nfatree( assert(t != NULL && t->begin != NULL); if (t->left != NULL) { - (DISCARD) nfatree(v, t->left, f); + (void) nfatree(v, t->left, f); } if (t->right != NULL) { - (DISCARD) nfatree(v, t->right, f); + (void) nfatree(v, t->right, f); } return nfanode(v, t, f); diff --git a/generic/regcustom.h b/generic/regcustom.h index 681b97d..1f00bf4 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -37,9 +37,9 @@ */ #define FUNCPTR(name, args) (*name)args -#define MALLOC(n) VS(attemptckalloc(n)) -#define FREE(p) ckfree(VS(p)) -#define REALLOC(p,n) VS(attemptckrealloc(VS(p),n)) +#define MALLOC(n) (void*)(attemptckalloc(n)) +#define FREE(p) ckfree((void*)(p)) +#define REALLOC(p,n) (void*)(attemptckrealloc((void*)(p),n)) /* * Do not insert extras between the "begin" and "end" lines - this chunk is diff --git a/generic/regexec.c b/generic/regexec.c index 6d12827..128d439 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -44,7 +44,7 @@ struct sset { /* state set */ unsigned hash; /* hash of bitvector */ #define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw)) #define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \ - memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0)) + memcmp((void*)(bv), (void*)((ss)->states), (nw)*sizeof(unsigned)) == 0)) int flags; #define STARTER 01 /* the initial state set */ #define POSTSTATE 02 /* includes the goal state */ @@ -268,7 +268,7 @@ exec( if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) { zapallsubs(pmatch, nmatch); n = (nmatch < v->nmatch) ? nmatch : v->nmatch; - memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t)); + memcpy((void*)(pmatch), (void*)(v->pmatch), n*sizeof(regmatch_t)); } /* diff --git a/generic/regguts.h b/generic/regguts.h index 1ac2465..9461136 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -49,23 +49,6 @@ #include <assert.h> #endif -/* voids */ -#ifndef VOID -#define VOID void /* for function return values */ -#endif -#ifndef DISCARD -#define DISCARD void /* for throwing values away */ -#endif -#ifndef PVOID -#define PVOID void * /* generic pointer */ -#endif -#ifndef VS -#define VS(x) ((void*)(x)) /* cast something to generic ptr */ -#endif -#ifndef NOPARMS -#define NOPARMS void /* for empty parm lists */ -#endif - /* function-pointer declarator */ #ifndef FUNCPTR #if __STDC__ >= 1 @@ -80,10 +63,10 @@ #define MALLOC(n) malloc(n) #endif #ifndef REALLOC -#define REALLOC(p, n) realloc(VS(p), n) +#define REALLOC(p, n) realloc(p, n) #endif #ifndef FREE -#define FREE(p) free(VS(p)) +#define FREE(p) free(p) #endif /* want size of a char in bits, and max value in bounded quantifiers */ diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 73bd36f..cca4069 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1717,19 +1717,27 @@ InfoLoadedCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *interpName; + const char *interpName, *packageName; - if ((objc != 1) && (objc != 2)) { - Tcl_WrongNumArgs(interp, 1, objv, "?interp?"); + if (objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "?interp? ?packageName?"); return TCL_ERROR; } - if (objc == 1) { /* Get loaded pkgs in all interpreters. */ + if (objc < 2) { /* Get loaded pkgs in all interpreters. */ interpName = NULL; } else { /* Get pkgs just in specified interp. */ interpName = TclGetString(objv[1]); + if (!interpName[0]) { + interpName = NULL; + } + } + if (objc < 3) { /* Get loaded files in all packages. */ + packageName = NULL; + } else { /* Get pkgs just in specified interp. */ + packageName = TclGetString(objv[2]); } - return TclGetLoadedPackages(interp, interpName); + return TclGetLoadedPackages(interp, interpName, packageName); } /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 023c671..ed3d9a5 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1009,7 +1009,6 @@ TclNRSourceObjCmd( } encodingName = TclGetString(objv[2]); } - return TclNREvalFile(interp, fileName, encodingName); } diff --git a/generic/tclHash.c b/generic/tclHash.c index ac9d40e..78ad514 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -924,7 +924,7 @@ HashStringKey( * * BogusFind -- * - * This function is invoked when an Tcl_FindHashEntry is called on a + * This function is invoked when Tcl_FindHashEntry is called on a * table that has been deleted. * * Results: @@ -951,7 +951,7 @@ BogusFind( * * BogusCreate -- * - * This function is invoked when an Tcl_CreateHashEntry is called on a + * This function is invoked when Tcl_CreateHashEntry is called on a * table that has been deleted. * * Results: diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index e3a6b2a..de5d62d 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1890,6 +1890,7 @@ TclNREvalFile( Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return TCL_ERROR; } + TclPkgFileSeen(interp, Tcl_GetString(pathPtr)); /* * The eofchar is \32 (^Z). This is the usual on Windows, but we effect diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 8314925..5730624 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -165,7 +165,7 @@ declare 34 { # int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr) #} declare 37 { - int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName) + int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName, const char *packageName) } declare 38 { int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index dfa5727..7f853b2 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -135,7 +135,8 @@ EXTERN int TclGetIntForIndex(Tcl_Interp *interp, /* Slot 36 is reserved */ /* 37 */ EXTERN int TclGetLoadedPackages(Tcl_Interp *interp, - const char *targetName); + const char *targetName, + const char *packageName); /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, @@ -659,7 +660,7 @@ typedef struct TclIntStubs { int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */ void (*reserved35)(void); void (*reserved36)(void); - int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */ + int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName, const char *packageName); /* 37 */ int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 184c158..2d8ed5f 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -397,12 +397,6 @@ Tcl_LoadObjCmd( goto done; } - if (target == interp) { - /* Only register the file if the load is done in the - * current interpreter */ - TclPkgFileSeen(target, Tcl_GetString(objv[1])); - } - /* * Create a new record to describe this package. */ @@ -1040,10 +1034,13 @@ int TclGetLoadedPackages( Tcl_Interp *interp, /* Interpreter in which to return information * or error message. */ - const char *targetName) /* Name of target interpreter or NULL. If + const char *targetName, /* Name of target interpreter or NULL. If * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ + const char *packageName) /* Package name or NULL. If NULL, return info + * all packages. + */ { Tcl_Interp *target; LoadedPackage *pkgPtr; @@ -1054,6 +1051,22 @@ TclGetLoadedPackages( /* * Return information about all of the available packages. */ + if (packageName) { + resultObj = NULL; + Tcl_MutexLock(&packageMutex); + for (pkgPtr = firstPackagePtr; pkgPtr != NULL; + pkgPtr = pkgPtr->nextPtr) { + if (!strcmp(packageName, pkgPtr->packageName)) { + resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1); + break; + } + } + Tcl_MutexUnlock(&packageMutex); + if (resultObj) { + Tcl_SetObjResult(interp, resultObj); + } + return TCL_OK; + } resultObj = Tcl_NewObj(); Tcl_MutexLock(&packageMutex); diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 3d052a6..c258987 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -204,12 +204,20 @@ static void PkgFilesCleanupProc(ClientData clientData, Tcl_Interp *interp) { PkgFiles *pkgFiles = (PkgFiles *) clientData; + Tcl_HashSearch search; + Tcl_HashEntry *entry; while (pkgFiles->names) { PkgName *name = pkgFiles->names; pkgFiles->names = name->nextPtr; ckfree(name); } + entry = Tcl_FirstHashEntry(&pkgFiles->table, &search); + while (entry) { + Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(entry); + Tcl_DecrRefCount(obj); + entry = Tcl_NextHashEntry(&search); + } Tcl_DeleteHashTable(&pkgFiles->table); return; } @@ -217,9 +225,20 @@ static void PkgFilesCleanupProc(ClientData clientData, void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName) { PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); - if (pkgFiles) { + if (pkgFiles && pkgFiles->names) { const char *name = pkgFiles->names->name; - printf("Seen %s for package %s\n", fileName, name); + Tcl_HashTable *table = &pkgFiles->table; + int new; + Tcl_HashEntry *entry = Tcl_CreateHashEntry(table, name, &new); + Tcl_Obj *obj = Tcl_NewStringObj(fileName, -1); + + if (new) { + Tcl_SetHashValue(entry, obj); + Tcl_IncrRefCount(obj); + } else { + Tcl_Obj *list = Tcl_GetHashValue(entry); + Tcl_ListObjAppendElement(interp, list, obj); + } } } @@ -848,24 +867,19 @@ Tcl_PackageObjCmd( } switch ((enum pkgOptions) optionIndex) { case PKG_FILES: { - const char *keyString; - Tcl_Obj *result = Tcl_NewObj(); + PkgFiles *pkgFiles; - for (i = 2; i < objc; i++) { - keyString = TclGetString(objv[i]); - hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString); - if (hPtr == NULL) { - continue; - } - pkgPtr = Tcl_GetHashValue(hPtr); - availPtr = pkgPtr->availPtr; - while (availPtr != NULL) { - Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(availPtr->script, -1)); - availPtr = availPtr->nextPtr; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "package"); + return TCL_ERROR; + } + pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); + if (pkgFiles) { + Tcl_HashEntry *entry = Tcl_FindHashEntry(&pkgFiles->table, Tcl_GetString(objv[2])); + if (entry) { + Tcl_SetObjResult(interp, (Tcl_Obj *)Tcl_GetHashValue(entry)); } - ckfree(pkgPtr); } - Tcl_SetObjResult(interp, result); break; } case PKG_FORGET: { diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index ea25d4b..eb23f72 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -502,9 +502,16 @@ Tcl_RegExpMatchObj( { Tcl_RegExp re; - re = Tcl_GetRegExpFromObj(interp, patternObj, - TCL_REG_ADVANCED | TCL_REG_NOSUB); - if (re == NULL) { + /* + * For performance reasons, first try compiling the RE without support for + * subexpressions. On failure, try again without TCL_REG_NOSUB in case the + * RE has backreferences in it. Closely related to [Bug 1366683]. If this + * still fails, an error message will be left in the interpreter. + */ + + if (!(re = Tcl_GetRegExpFromObj(interp, patternObj, + TCL_REG_ADVANCED | TCL_REG_NOSUB)) + && !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) { return -1; } return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */, |