Tcl Source Code

Check-in [958a4f2ca0]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:* generic/tclFileName.c: Moved global regexps into thread local storage.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1:958a4f2ca002fd7e15e586c6dfaed9d688b3e416
User & Date: stanton 1999-04-05 23:14:26
Context
1999-04-05
23:14
*** empty log message *** check-in: 044e1720ab user: stanton tags: core-8-1-branch-old
23:14
* generic/tclFileName.c: Moved global regexps into thread local storage. check-in: 958a4f2ca0 user: stanton tags: core-8-1-branch-old
23:14
* tests/platform.test: * tests/fileName.test: Fixed broken tests. check-in: 2064a18cad user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclFileName.c. 

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
41
42
43
44
45
46
47


48
49
50



51
52
53
54
55
56
57
..
61
62
63
64
65
66
67

68
69
70
71
72
73
74
..
89
90
91
92
93
94
95
96
97

98
99
100
101
102
103
104
105
106
107
108
109
110
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
...
164
165
166
167
168
169
170

171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
...
231
232
233
234
235
236
237

238
239
240
241
242
243
244
...
249
250
251
252
253
254
255

256
257
258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
...
275
276
277
278
279
280
281

282
283
284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
...
554
555
556
557
558
559
560

561
562
563
564
565
566
567
568
569
570
571
572
573
574

575
576
577
578
579
580
581
582

 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclFileName.c,v 1.1.2.11 1999/04/05 22:20:30 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/*
 * This variable indicates whether the cleanup procedure has been
 * registered for this file yet.
 */

static int initialized = 0;

/*
 * The following regular expression matches the root portion of a Windows
 * absolute or volume relative path.  It will match both UNC and drive relative
 * paths.
 */

#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*"
................................................................................
#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"

/*
 * The following variables are used to hold precompiled regular expressions
 * for use in filename matching.
 */



static Tcl_Obj *winRootPatternPtr = NULL;
static Tcl_Obj *macRootPatternPtr = NULL;
TCL_DECLARE_MUTEX(nameMutex)




/*
 * The following variable is set in the TclPlatformInit call to one
 * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
 */

TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
................................................................................
 */

static char *		DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *user, Tcl_DString *resultPtr));
static CONST char *	ExtractWinRoot _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *resultPtr, int offset));
static void		FileNameCleanup _ANSI_ARGS_((ClientData clientData));

static int		SkipToChar _ANSI_ARGS_((char **stringPtr,
			    char *match));
static char *		SplitMacPath _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *bufPtr));
static char *		SplitWinPath _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *bufPtr));
static char *		SplitUnixPath _ANSI_ARGS_((CONST char *path,
................................................................................
 *
 *----------------------------------------------------------------------
 */

static void
FileNameInit()
{
    Tcl_MutexLock(&nameMutex);
    if (!initialized) {

	winRootPatternPtr = Tcl_NewStringObj(WIN_ROOT_PATTERN, -1);
	macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1);
	Tcl_CreateExitHandler(FileNameCleanup, NULL);
	initialized = 1;
    }
    Tcl_MutexUnlock(&nameMutex);
}
 
/*
 *----------------------------------------------------------------------
 *
 * FileNameCleanup --
 *
................................................................................
 *----------------------------------------------------------------------
 */

static void
FileNameCleanup(clientData)
    ClientData clientData;	/* Not used. */
{
    Tcl_MutexLock(&nameMutex);
    if (winRootPatternPtr != NULL) {
	Tcl_DecrRefCount(winRootPatternPtr);
        winRootPatternPtr = NULL;
    }
    if (macRootPatternPtr != NULL) {
	Tcl_DecrRefCount(macRootPatternPtr);
        macRootPatternPtr = NULL;
    }
    initialized = 0;
    Tcl_MutexUnlock(&nameMutex);
}
 
/*
 *----------------------------------------------------------------------
 *
 * ExtractWinRoot --
 *
................................................................................
    int offset;			/* Offset in buffer where result should be
				 * stored. */
{
    int length;
    Tcl_RegExp re;
    char *dummy, *tail, *drive, *hostStart, *hostEnd, *shareStart,
	*shareEnd, *lastSlash;


    /*
     * Initialize the path name parser for Windows path names.
     */

    if (!initialized) {
	FileNameInit();
    }

    re = Tcl_GetRegExpFromObj(NULL, winRootPatternPtr, REG_ADVANCED);

    /*
     * Match the root portion of a Windows path name.
     */

    if (!Tcl_RegExpExec(NULL, re, path, path)) {
	return path;
................................................................................
 *----------------------------------------------------------------------
 */

Tcl_PathType
Tcl_GetPathType(path)
    char *path;
{

    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    Tcl_RegExp re;

    switch (tclPlatform) {
   	case TCL_PLATFORM_UNIX:
	    /*
	     * Paths that begin with / or ~ are absolute.
................................................................................
	    }
	    break;

	case TCL_PLATFORM_MAC:
	    if (path[0] == ':') {
		type = TCL_PATH_RELATIVE;
	    } else if (path[0] != '~') {


		/*
		 * Since we have eliminated the easy cases, use the
		 * root pattern to look for the other types.
		 */

		if (!initialized) {
		    FileNameInit();
		}
		re = Tcl_GetRegExpFromObj(NULL, macRootPatternPtr, REG_ADVANCED);


		if (!Tcl_RegExpExec(NULL, re, path, path)) {
		    type = TCL_PATH_RELATIVE;
		} else {
		    char *unixRoot, *dummy;

		    Tcl_RegExpRange(re, 2, &unixRoot, &dummy);
................................................................................
		    }
		}
	    }
	    break;
	
	case TCL_PLATFORM_WINDOWS:
	    if (path[0] != '~') {


		/*
		 * Since we have eliminated the easy cases, check for
		 * drive relative paths using the regular expression.
		 */

		if (!initialized) {
		    FileNameInit();
		}
		re = Tcl_GetRegExpFromObj(NULL, winRootPatternPtr, REG_ADVANCED);


		if (Tcl_RegExpExec(NULL, re, path, path)) {
		    char *drive, *dummy, *unixRoot, *lastSlash;

		    Tcl_RegExpRange(re, 2, &drive, &dummy);
		    Tcl_RegExpRange(re, 5, &unixRoot, &dummy);
		    Tcl_RegExpRange(re, 6, &lastSlash, &dummy);
................................................................................
    CONST char *path;		/* Pointer to string containing a path. */
    Tcl_DString *bufPtr;	/* Pointer to DString to use for the result. */
{
    int isMac = 0;		/* 1 if is Mac-style, 0 if Unix-style path. */
    int i, length;
    CONST char *p, *elementStart;
    Tcl_RegExp re;


    /*
     * Initialize the path name parser for Macintosh path names.
     */

    if (!initialized) {
	FileNameInit();
    }

    /*
     * Match the root portion of a Mac path name.
     */

    i = 0;			/* Needed only to prevent gcc warnings. */

    re = Tcl_GetRegExpFromObj(NULL, macRootPatternPtr, REG_ADVANCED);

    if (Tcl_RegExpExec(NULL, re, path, path) == 1) {
	char *start, *end;

	/*
	 * Treat degenerate absolute paths like / and /../.. as
	 * Mac relative file names for lack of anything else to do.







|






<
<
<
<
<
<
<







 







>
>
|
|
<
>
>
>







 







>







 







|
|
>
|
|
|
<

<







 







|
<
<
|
<
<
<
|
<
|
<







 







>





<
|
|
<
|







 







>







 







>






<
|
<
|
>







 







>






<
|
<
|
>







 







>





<
|
<






>
|








6
7
8
9
10
11
12
13
14
15
16
17
18
19







20
21
22
23
24
25
26
..
34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
52
53
54
..
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
..
87
88
89
90
91
92
93
94
95
96
97
98
99

100

101
102
103
104
105
106
107
...
117
118
119
120
121
122
123
124


125



126

127

128
129
130
131
132
133
134
...
154
155
156
157
158
159
160
161
162
163
164
165
166

167
168

169
170
171
172
173
174
175
176
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
239
240
241
242
243
244
245
246
247
248
249
250
251
252

253

254
255
256
257
258
259
260
261
262
...
265
266
267
268
269
270
271
272
273
274
275
276
277
278

279

280
281
282
283
284
285
286
287
288
...
544
545
546
547
548
549
550
551
552
553
554
555
556

557

558
559
560
561
562
563
564
565
566
567
568
569
570
571
572

 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclFileName.c,v 1.1.2.12 1999/04/05 23:14:26 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"








/*
 * The following regular expression matches the root portion of a Windows
 * absolute or volume relative path.  It will match both UNC and drive relative
 * paths.
 */

#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*"
................................................................................
#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"

/*
 * The following variables are used to hold precompiled regular expressions
 * for use in filename matching.
 */

typedef struct ThreadSpecificData {
    int initialized;
    Tcl_Obj *winRootPatternPtr;
    Tcl_Obj *macRootPatternPtr;

} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following variable is set in the TclPlatformInit call to one
 * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
 */

TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
................................................................................
 */

static char *		DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *user, Tcl_DString *resultPtr));
static CONST char *	ExtractWinRoot _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *resultPtr, int offset));
static void		FileNameCleanup _ANSI_ARGS_((ClientData clientData));
static void		FileNameInit _ANSI_ARGS_((void));
static int		SkipToChar _ANSI_ARGS_((char **stringPtr,
			    char *match));
static char *		SplitMacPath _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *bufPtr));
static char *		SplitWinPath _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *bufPtr));
static char *		SplitUnixPath _ANSI_ARGS_((CONST char *path,
................................................................................
 *
 *----------------------------------------------------------------------
 */

static void
FileNameInit()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;
	tsdPtr->winRootPatternPtr = Tcl_NewStringObj(WIN_ROOT_PATTERN, -1);
	tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1);
	Tcl_CreateThreadExitHandler(FileNameCleanup, NULL);

    }

}
 
/*
 *----------------------------------------------------------------------
 *
 * FileNameCleanup --
 *
................................................................................
 *----------------------------------------------------------------------
 */

static void
FileNameCleanup(clientData)
    ClientData clientData;	/* Not used. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);


    Tcl_DecrRefCount(tsdPtr->winRootPatternPtr);



    Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);

    tsdPtr->initialized = 0;

}
 
/*
 *----------------------------------------------------------------------
 *
 * ExtractWinRoot --
 *
................................................................................
    int offset;			/* Offset in buffer where result should be
				 * stored. */
{
    int length;
    Tcl_RegExp re;
    char *dummy, *tail, *drive, *hostStart, *hostEnd, *shareStart,
	*shareEnd, *lastSlash;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Initialize the path name parser for Windows path names.
     */


    FileNameInit();


    re = Tcl_GetRegExpFromObj(NULL, tsdPtr->winRootPatternPtr, REG_ADVANCED);

    /*
     * Match the root portion of a Windows path name.
     */

    if (!Tcl_RegExpExec(NULL, re, path, path)) {
	return path;
................................................................................
 *----------------------------------------------------------------------
 */

Tcl_PathType
Tcl_GetPathType(path)
    char *path;
{
    ThreadSpecificData *tsdPtr;
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    Tcl_RegExp re;

    switch (tclPlatform) {
   	case TCL_PLATFORM_UNIX:
	    /*
	     * Paths that begin with / or ~ are absolute.
................................................................................
	    }
	    break;

	case TCL_PLATFORM_MAC:
	    if (path[0] == ':') {
		type = TCL_PATH_RELATIVE;
	    } else if (path[0] != '~') {
		tsdPtr = TCL_TSD_INIT(&dataKey);

		/*
		 * Since we have eliminated the easy cases, use the
		 * root pattern to look for the other types.
		 */


		FileNameInit();

		re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr,
			REG_ADVANCED);

		if (!Tcl_RegExpExec(NULL, re, path, path)) {
		    type = TCL_PATH_RELATIVE;
		} else {
		    char *unixRoot, *dummy;

		    Tcl_RegExpRange(re, 2, &unixRoot, &dummy);
................................................................................
		    }
		}
	    }
	    break;
	
	case TCL_PLATFORM_WINDOWS:
	    if (path[0] != '~') {
		tsdPtr = TCL_TSD_INIT(&dataKey);

		/*
		 * Since we have eliminated the easy cases, check for
		 * drive relative paths using the regular expression.
		 */


		FileNameInit();

		re = Tcl_GetRegExpFromObj(NULL, tsdPtr->winRootPatternPtr,
			REG_ADVANCED);

		if (Tcl_RegExpExec(NULL, re, path, path)) {
		    char *drive, *dummy, *unixRoot, *lastSlash;

		    Tcl_RegExpRange(re, 2, &drive, &dummy);
		    Tcl_RegExpRange(re, 5, &unixRoot, &dummy);
		    Tcl_RegExpRange(re, 6, &lastSlash, &dummy);
................................................................................
    CONST char *path;		/* Pointer to string containing a path. */
    Tcl_DString *bufPtr;	/* Pointer to DString to use for the result. */
{
    int isMac = 0;		/* 1 if is Mac-style, 0 if Unix-style path. */
    int i, length;
    CONST char *p, *elementStart;
    Tcl_RegExp re;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Initialize the path name parser for Macintosh path names.
     */


    FileNameInit();


    /*
     * Match the root portion of a Mac path name.
     */

    i = 0;			/* Needed only to prevent gcc warnings. */

    re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, REG_ADVANCED);

    if (Tcl_RegExpExec(NULL, re, path, path) == 1) {
	char *start, *end;

	/*
	 * Treat degenerate absolute paths like / and /../.. as
	 * Mac relative file names for lack of anything else to do.

This page was generated in about 0.022s by Fossil 2.9 [cbc21e5290] 2019-04-11 01:17:26