Tcl Source Code

Changes On Branch tip-691
Login
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

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

Changes In Branch tip-691 Excluding Merge-Ins

This is equivalent to a diff from ba65f6c8c4 to 156c6cc448

2024-04-24
15:48
Merge some trunk changes. check-in: c4ee2d267c user: dgp tags: core-9-0-b2-rc
2024-04-11
14:09
Merge 8.7 check-in: 93e55377dc user: jan.nijtmans tags: trunk, main
13:15
Merge 8.6. Use Tcl_NewBooleanObj for booleans; we should say what we mean check-in: c6d3960498 user: jan.nijtmans tags: core-8-branch
12:35
Use Tcl_NewBooleanObj for booleans; we should say what we mean. Fix sentinels and type-casts. check-in: e75d7ff329 user: jan.nijtmans tags: core-8-6-branch
11:03
Merge 9.0 Leaf check-in: 156c6cc448 user: jan.nijtmans tags: tip-691
08:55
Use Tcl_NewBooleanObj for booleans; we should say what we mean check-in: ba65f6c8c4 user: dkf tags: trunk, main
08:35
Fix [e155cedf33]: Error-handling in TclGetOpenMode() check-in: 22e66b7f41 user: jan.nijtmans tags: trunk, main
2024-04-10
11:52
Merge 9.0 check-in: f4b3e69a07 user: jan.nijtmans tags: tip-691

Changes to doc/FileSystem.3.

198
199
200
201
202
203
204



205
206
207
208
209
210
211
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214







+
+
+







As for \fIpathPtr\fR, but used for the destination filename for a copy or
rename operation.
.AP int recursive in
Whether to remove subdirectories and their contents as well.
.AP "const char" *encodingName in
The encoding of the data stored in the
file identified by \fIpathPtr\fR and to be evaluated.
Can also be set to \fBTCL_ENCODING_UTF8_STRICT\fR,
\fBTCL_ENCODING_UTF8_REPLACE\fR or \fBTCL_ENCODING_UTF8_TCL8\fR,
which selects `utf-8` in combination with one of the 3 possible profiles.
.AP "const char" *pattern in
Only files or directories matching this pattern will be returned.
.AP Tcl_GlobTypeData *types in
Only files or directories matching the type descriptions contained in
this structure will be returned. This parameter may be NULL.
.AP Tcl_Interp *interp in
Interpreter to use either for results, evaluation, or reporting error
419
420
421
422
423
424
425
426

427
428
429
430





431
432
433
434
435
436
437
422
423
424
425
426
427
428

429
430
431


432
433
434
435
436
437
438
439
440
441
442
443







-
+


-
-
+
+
+
+
+







\fBTcl_FSListVolumes\fR calls each filesystem which has a non-NULL
.QW "list volumes"
function and asks them to return their list of root volumes. It
accumulates the return values in a list which is returned to the
caller (with a reference count of 0).
.PP
\fBTcl_FSEvalFileEx\fR reads the file given by \fIpathPtr\fR using
the encoding identified by \fIencodingName\fR and evaluates
the encoding/profile identified by \fIencodingName\fR and evaluates
its contents as a Tcl script. It returns the same information as
\fBTcl_EvalObjEx\fR.
If \fIencodingName\fR is NULL, the utf-8 encoding is used for
reading the file contents.
If \fIencodingName\fR is NULL, the utf-8 encoding and the
strict profile is used for reading the file contents.
If \fIencodingName\fR is set to \fBTCL_ENCODING_UTF8_STRICT\fR,
\fBTCL_ENCODING_UTF8_REPLACE\fR or \fBTCL_ENCODING_UTF8_TCL8\fR, the
profile is set to the given value, the encoding is utf-8.
If the file could not be read then a Tcl error is returned to describe
why the file could not be read.
The eofchar for files is
.QW \ex1A
(^Z) for all platforms.
If you require a
.QW ^Z

Changes to doc/Tcl_Main.3.

41
42
43
44
45
46
47
48



49
50
51
52
53
54
55
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55
56
57







-
+
+
+







As argv, but type is always wchar_t.
.AP Tcl_AppInitProc *appInitProc in
Address of an application-specific initialization procedure.
The value for this argument is usually \fBTcl_AppInit\fR.
.AP Tcl_Obj *path in
Name of file to use as startup script, or NULL.
.AP "const char" *encoding in
Encoding of file to use as startup script, or NULL.
Encoding of file to use as startup script, or NULL, or
\fBTCL_ENCODING_UTF8_STRICT\fR, \fBTCL_ENCODING_UTF8_REPLACE\fR
or \fBTCL_ENCODING_UTF8_TCL8\fR.
.AP "const char" **encodingPtr out
If non-NULL, location to write a copy of the (const char *)
pointing to the encoding name.
.AP Tcl_MainLoopProc *mainLoopProc in
Address of an application-specific event loop procedure.
.AP Tcl_Interp *interp in
Already created Tcl Interpreter.

Changes to doc/open.n.

56
57
58
59
60
61
62
63


64
65
66
67
68
69
70
56
57
58
59
60
61
62

63
64
65
66
67
68
69
70
71







-
+
+







\fBb\fR added as the second or third character in the value to
indicate that the opened channel should be configured as if with the
\fBfconfigure\fR \fB\-translation binary\fR option, making the channel suitable for
reading or writing of binary data.
.PP
In the second form, \fIaccess\fR consists of a list of any of the
following flags, most of which have the standard POSIX meanings.
One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR.
If none of \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR are specified,
\fBRDONLY\fR is the default.
.IP \fBRDONLY\fR
Open the file for reading only.
.IP \fBWRONLY\fR
Open the file for writing only.
.IP \fBRDWR\fR
Open the file for both reading and writing.
.IP \fBAPPEND\fR

Changes to doc/source.n.

43
44
45
46
47
48
49



50
51
52
53
54
55
56
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59







+
+
+







.PP
A leading BOM (Byte order mark) contained in the file is ignored for
unicode encodings (utf-8, utf-16, ucs-2).
.PP
The \fB\-encoding\fR option is used to specify the encoding of
the data stored in \fIfileName\fR.  When the \fB\-encoding\fR option
is omitted, the utf-8 encoding is assumed.
.PP
The \fB\-profile\fR option is used to specify the profile. Can be
"tcl8", "replace" or "strict".
.SH EXAMPLE
.PP
Run the script in the file \fBfoo.tcl\fR and then the script in the
file \fBbar.tcl\fR:
.PP
.CS
\fBsource\fR foo.tcl

Changes to generic/tcl.h.

2026
2027
2028
2029
2030
2031
2032




2033
2034
2035
2036
2037
2038
2039
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043







+
+
+
+







 * Reserve top byte for profile values (disjoint, not a mask). In case of
 * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
 * necessary.
 */
#define TCL_ENCODING_PROFILE_STRICT   TCL_ENCODING_STOPONERROR
#define TCL_ENCODING_PROFILE_TCL8     0x01000000
#define TCL_ENCODING_PROFILE_REPLACE  0x02000000

#define TCL_ENCODING_UTF8_STRICT      ((const char *)-1)
#define TCL_ENCODING_UTF8_REPLACE     ((const char *)-2)
#define TCL_ENCODING_UTF8_TCL8        ((const char *)-3)

/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
 * TCL_OK -			All characters were converted.
 * TCL_CONVERT_NOSPACE -	The output buffer would not have been large

Changes to generic/tclCmdMZ.c.

1106
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
1121

1122
1123
1124
1125
1126
1127
1128














1129

1130
1131
1132
1133
1134
1135
1136
1106
1107
1108
1109
1110
1111
1112

1113
1114
1115
1116
1117
1118
1119
1120

1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151







-
+







-
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+

+







    const char *encodingName = NULL;
    Tcl_Obj *fileName;
    int result;
    void **pkgFiles = NULL;
    void *names = NULL;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding encoding? fileName");
	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding encoding|-profile profile? fileName");
	return TCL_ERROR;
    }

    fileName = objv[objc-1];

    if (objc == 4) {
	static const char *const options[] = {
	    "-encoding", NULL
	    "-encoding", "-profile", NULL
	};
	int index;

	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options,
		"option", TCL_EXACT, &index)) {
	    return TCL_ERROR;
	}
	if (index) {
	    int id;
	    result = TclEncodingProfileNameToId(interp, TclGetString(objv[2]), &id);
	    if (result != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (id == TCL_ENCODING_PROFILE_TCL8) {
		encodingName = TCL_ENCODING_UTF8_TCL8;
	    } else if (id == TCL_ENCODING_PROFILE_REPLACE) {
		encodingName = TCL_ENCODING_UTF8_REPLACE;
	    } else {
		encodingName = NULL;
	    }
	} else {
	encodingName = TclGetString(objv[2]);
	}
    } else if (objc == 3) {
	/* Handle undocumented -nopkg option. This should only be
	 * used by the internal ::tcl::Pkg::source utility function. */
	static const char *const nopkgoptions[] = {
	    "-nopkg", NULL
	};
	int index;

Changes to generic/tclIOCmd.c.

1159
1160
1161
1162
1163
1164
1165

1166
1167







1168
1169
1170
1171
1172
1173
1174
1159
1160
1161
1162
1163
1164
1165
1166


1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180







+
-
-
+
+
+
+
+
+
+







		flags |= (TCL_STDIN | TCL_STDOUT);
		break;
	    default:
		Tcl_Panic("Tcl_OpenCmd: invalid mode value");
		break;
	    }
	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
	    if (chan) {
	    if ((modeFlags & CHANNEL_RAW_MODE) && chan) {
		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
		if (modeFlags & CHANNEL_RAW_MODE) {
		    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
		} else if (ENCODING_PROFILE_GET(modeFlags) == TCL_ENCODING_PROFILE_TCL8) {
		    Tcl_SetChannelOption(interp, chan, "-profile", "tcl8");
		} else if (ENCODING_PROFILE_GET(modeFlags) == TCL_ENCODING_PROFILE_REPLACE) {
		    Tcl_SetChannelOption(interp, chan, "-profile", "replace");
		}
	    }
	}
	Tcl_Free((void *)cmdArgv);
    }
    if (chan == NULL) {
	return TCL_ERROR;
    }

Changes to generic/tclIOUtil.c.

1421
1422
1423
1424
1425
1426
1427
1428
1429




1430
1431
1432


1433
1434
1435
1436
1437
1438
1439
1421
1422
1423
1424
1425
1426
1427


1428
1429
1430
1431
1432


1433
1434
1435
1436
1437
1438
1439
1440
1441







-
-
+
+
+
+

-
-
+
+







 *
 *	Computes a POSIX mode mask for opening a file.
 *
 * Results:
 *	The mode to pass to "open", or -1 if an error occurs.
 *
 * Side effects:
 *	Sets *modeFlagsPtr to 1 to tell the caller to
 *	seek to EOF after opening the file, or to 0 otherwise.
 *	Sets *modeFlagsPtr to the expected profile. 0 is the default.
 *
 *	Adds 1 to *modeFlagsPtr to tell the caller to seek to EOF
 *	after opening the file.
 *
 *	Adds CHANNEL_RAW_MODE to *modeFlagsPtr to tell the caller
 *	to configure the channel as a binary channel.
 *	Adds 2 to *modeFlagsPtr to tell the caller to configure the
 *	channel as a binary channel.
 *
 *	If there is an error and interp is not NULL, sets
 *	interpreter result to an error message.
 *
 * Special note:
 *	Based on a prototype implementation contributed by Mark Diekhans.
 *
1621
1622
1623
1624
1625
1626
1627
1628
1629


1630
1631





















1632
1633
1634
1635
1636
1637

1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1623
1624
1625
1626
1627
1628
1629


1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659

1660
1661
1662
1663
1664
1665
1666









1667
1668
1669
1670
1671
1672
1673







-
-
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+






-
-
-
-
-
-
-
-
-







#endif
	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
	    if (mode & O_TRUNC) {
		goto accessFlagRepeated;
	    }
	    mode |= O_TRUNC;
	} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
	    if (*modeFlagsPtr & CHANNEL_RAW_MODE) {
		goto accessFlagRepeated;
	    if (*modeFlagsPtr & (ENCODING_PROFILE_MASK|CHANNEL_RAW_MODE)) {
		goto invAccess;
	    }
	    *modeFlagsPtr |= CHANNEL_RAW_MODE;
	} else if ((c == 'T') && (strcmp(flag, "TCL8") == 0)) {
	    if (*modeFlagsPtr & (ENCODING_PROFILE_MASK|CHANNEL_RAW_MODE)) {
	    invAccess:
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
				"invalid access mode \"%s\": modes BINARY, "
				"REPLACE, STRICT, and TCL8 cannot be combined", flag));
		}
		goto invAccessMode;
	    }
	    *modeFlagsPtr |= TCL_ENCODING_PROFILE_TCL8;
	} else if ((c == 'S') && (strcmp(flag, "STRICT") == 0)) {
	    if (*modeFlagsPtr & (ENCODING_PROFILE_MASK|CHANNEL_RAW_MODE)) {
		goto invAccess;
	    }
	    *modeFlagsPtr |= TCL_ENCODING_PROFILE_STRICT;
	} else if ((c == 'R') && (strcmp(flag, "REPLACE") == 0)) {
	    if (*modeFlagsPtr & (ENCODING_PROFILE_MASK|CHANNEL_RAW_MODE)) {
		goto invAccess;
	    }
	    *modeFlagsPtr |= TCL_ENCODING_PROFILE_REPLACE;
	} else {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"invalid access mode \"%s\": must be APPEND, BINARY, "
			"CREAT, EXCL, NOCTTY, NONBLOCK, RDONLY, RDWR, "
			"TRUNC, or WRONLY", flag));
			"REPLACE, STRICT, TCL8, TRUNC, or WRONLY", flag));
	    }
	    goto invAccessMode;
	}
    }

    Tcl_Free((void *)modeArgv);

    if (!gotRW) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "access mode must include either RDONLY, RDWR, or WRONLY",
		    -1));
	}
	return -1;
    }
    return mode;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSEvalFile, Tcl_FSEvalFileEx, TclNREvalFile --
1689
1690
1691
1692
1693
1694
1695
1696



1697
1698
1699
1700
1701
1702
1703
1703
1704
1705
1706
1707
1708
1709

1710
1711
1712
1713
1714
1715
1716
1717
1718
1719







-
+
+
+







int
Tcl_FSEvalFileEx(
    Tcl_Interp *interp,		/* Interpreter that evaluates the script. */
    Tcl_Obj *pathPtr,		/* Pathname of the file to process.
				 * Tilde-substitution is performed on this
				 * pathname. */
    const char *encodingName)	/* Either the name of an encoding or NULL to
				   use the utf-8 encoding. */
				   use the utf-8 encoding. May also be TCL_ENCODING_UTF8_STRICT,
				   TCL_ENCODING_UTF8_REPLACE, or TCL_ENCODING_UTF8_TCL8,
				   for specifying the profile. */
{
    Tcl_Size length;
    int result = TCL_ERROR;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    const char *string;
1731
1732
1733
1734
1735
1736
1737
1738








1739
1740
1741
1742
1743
1744
1745
1747
1748
1749
1750
1751
1752
1753

1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768







-
+
+
+
+
+
+
+
+







    Tcl_SetChannelOption(interp, chan, "-eofchar", "\x1A");

    /*
     * If the encoding is specified, set the channel to that encoding.
     * Otherwise use utf-8.  If the encoding is unknown report an error.
     */

    if (encodingName == NULL) {
    if (encodingName == NULL || encodingName == TCL_ENCODING_UTF8_STRICT) {
	goto utf8;
    } else if (encodingName == TCL_ENCODING_UTF8_REPLACE) {
	Tcl_SetChannelOption(interp, chan, "-profile", "replace");
	goto utf8;
    } else if (encodingName == TCL_ENCODING_UTF8_TCL8) {
	Tcl_SetChannelOption(interp, chan, "-profile", "tcl8");
    utf8:
	encodingName = "utf-8";
    }
    if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
	    != TCL_OK) {
	Tcl_CloseEx(interp,chan,0);
	return result;
    }
1867
1868
1869
1870
1871
1872
1873
1874








1875
1876
1877
1878
1879
1880
1881
1890
1891
1892
1893
1894
1895
1896

1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911







-
+
+
+
+
+
+
+
+







    Tcl_SetChannelOption(interp, chan, "-eofchar", "\x1A");

    /*
     * If the encoding is specified, set the channel to that encoding.
     * Otherwise use utf-8.  If the encoding is unknown report an error.
     */

    if (encodingName == NULL) {
    if (encodingName == NULL || encodingName == TCL_ENCODING_UTF8_STRICT) {
	goto utf8;
    } else if (encodingName == TCL_ENCODING_UTF8_REPLACE) {
	Tcl_SetChannelOption(interp, chan, "-profile", "replace");
	goto utf8;
    } else if (encodingName == TCL_ENCODING_UTF8_TCL8) {
	Tcl_SetChannelOption(interp, chan, "-profile", "tcl8");
    utf8:
	encodingName = "utf-8";
    }
    if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
	    != TCL_OK) {
	Tcl_CloseEx(interp, chan, 0);
	return TCL_ERROR;
    }
2244
2245
2246
2247
2248
2249
2250




2251
2252
2253
2254
2255
2256
2257
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291







+
+
+
+







			TclGetString(pathPtr), Tcl_PosixError(interp)));
	    }
	    Tcl_CloseEx(NULL, retVal, 0);
	    return NULL;
	}
	if (modeFlags & CHANNEL_RAW_MODE) {
	    Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
	} else if (ENCODING_PROFILE_GET(modeFlags) == TCL_ENCODING_PROFILE_TCL8) {
	    Tcl_SetChannelOption(interp, retVal, "-profile", "tcl8");
	} else if (ENCODING_PROFILE_GET(modeFlags) == TCL_ENCODING_PROFILE_REPLACE) {
	    Tcl_SetChannelOption(interp, retVal, "-profile", "replace");
	}
	return retVal;
    }

    /*
     * File doesn't belong to any filesystem that can open it.
     */

Changes to generic/tclInt.h.

3344
3345
3346
3347
3348
3349
3350
3351

3352
3353
3354
3355
3356
3357
3358
3344
3345
3346
3347
3348
3349
3350

3351
3352
3353
3354
3355
3356
3357
3358







-
+







MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
			    void *clientData, Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
			    const char *encoding);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
			    int *modePtr, int flags);
MODULE_SCOPE CmdFrame *	TclGetCmdFrameForProcedure(Proc *procPtr);
MODULE_SCOPE int	TclGetCompletionCodeFromObj(Tcl_Interp *interp,

Changes to generic/tclMain.c.

70
71
72
73
74
75
76
77

78
79
80
81
82
83
84
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84







-
+







 */

typedef struct {
    Tcl_Obj *path;		/* The filename of the script for *_Main()
				 * routines to [source] as a startup script,
				 * or NULL for none set, meaning enter
				 * interactive mode. */
    Tcl_Obj *encoding;		/* The encoding of the startup script file. */
    Tcl_Obj *encoding;		/* The encoding or profile of the startup script file. */
    Tcl_MainLoopProc *mainLoopProc;
				/* Any installed main loop handler. The main
				 * extension that installs these is Tk. */
} ThreadSpecificData;

/*
 * Structure definition for information used to keep the state of an
129
130
131
132
133
134
135



136
137
138
139

140
141
142

143
144
145


146


147
148
149
150
151
152
153
154
155
156
157

158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178




179
180
181
182
183
184
185
186
187



188
189
190
191
192
193

194
195
196

197
198
199
200
201
202
203
129
130
131
132
133
134
135
136
137
138
139
140
141

142
143
144

145
146


147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179




180
181
182
183
184
185
186
187
188
189



190
191
192

193
194
195
196

197
198
199

200
201
202
203
204
205
206
207







+
+
+



-
+


-
+

-
-
+
+

+
+










-
+

















-
-
-
-
+
+
+
+






-
-
-
+
+
+
-




-
+


-
+







 *	None.
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */

#define IS_ENCODING(encoding) ((encoding) && (((encoding) < TCL_ENCODING_UTF8_TCL8) \
	|| ((encoding) > TCL_ENCODING_UTF8_STRICT)))

void
Tcl_SetStartupScript(
    Tcl_Obj *path,		/* Filesystem path of startup script file */
    const char *encodingName)	/* Encoding of the data in that file */
    const char *encoding)	/* Encoding of the data in that file */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_Obj *encodingObj = NULL;
    Tcl_Obj *encodingObj;

    if (encodingName != NULL) {
	encodingObj = Tcl_NewStringObj(encodingName, -1);
    if (IS_ENCODING(encoding)) {
	encodingObj = Tcl_NewStringObj(encoding, -1);
	Tcl_IncrRefCount(encodingObj);
    } else {
	encodingObj = (Tcl_Obj *)encoding;
    }

    if (path != NULL) {
	Tcl_IncrRefCount(path);
    }
    if (tsdPtr->path != NULL) {
	Tcl_DecrRefCount(tsdPtr->path);
    }
    tsdPtr->path = path;

    if (tsdPtr->encoding != NULL) {
    if (IS_ENCODING((const char *)tsdPtr->encoding)) {
	Tcl_DecrRefCount(tsdPtr->encoding);
    }
    tsdPtr->encoding = encodingObj;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStartupScript --
 *
 *	Gets the path and encoding of the startup script to be evaluated by
 *	Tcl_Main.
 *
 * Results:
 *	The path of the startup script; NULL if none has been set.
 *
 * Side effects:
 *	If encodingPtr is not NULL, stores a (const char *) in it pointing to
 *	the encoding name registered for the startup script. Tcl retains
 *	ownership of the string, and may free it. Caller should make a copy
 *	for long-term use.
 *	If encodingPtr is not NULL, stores a (const char *) in it pointing
 *	to the encoding name or profile registered for the startup script.
 *	Tcl retains ownership of the string, and may free it. Caller
 *	should make a copy for long-term use.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetStartupScript(
    const char **encodingPtr)	/* When not NULL, points to storage for the
				 * (const char *) that points to the
				 * registered encoding name for the startup
    const char **encodingPtr)	/* When not NULL or TCL_ENCODING_UTF8_????,
				 * points to storage for the (const char *) that points to
				 * the registered encoding name for the startup script. */
				 * script. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (encodingPtr != NULL) {
	if (tsdPtr->encoding != NULL) {
	if (IS_ENCODING((const char *)tsdPtr->encoding)) {
	    *encodingPtr = Tcl_GetString(tsdPtr->encoding);
	} else {
	    *encodingPtr = NULL;
	    *encodingPtr = (const char *)tsdPtr->encoding;
	}
    }
    return tsdPtr->path;
}

/*----------------------------------------------------------------------
 *
323
324
325
326
327
328
329











330
331
332
333
334
335
336
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351







+
+
+
+
+
+
+
+
+
+
+







	/* mind argc is being adjusted as we proceed */
	if ((argc >= 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
		&& ('-' != argv[3][0])) {
	    Tcl_Obj *value = NewNativeObj(argv[2]);
	    Tcl_SetStartupScript(NewNativeObj(argv[3]),
		    Tcl_GetString(value));
	    Tcl_DecrRefCount(value);
	    argc -= 3;
	    i += 3;
	} else if ((argc >= 3) && (0 == _tcscmp(TEXT("-profile"), argv[1]))
		&& ('-' != argv[3][0])) {
	    if (0 == _tcscmp(TEXT("tcl8"), argv[2])) {
		Tcl_SetStartupScript(NewNativeObj(argv[3]), TCL_ENCODING_UTF8_TCL8);
	    } else if (0 == _tcscmp(TEXT("replace"), argv[2])) {
		Tcl_SetStartupScript(NewNativeObj(argv[3]), TCL_ENCODING_UTF8_REPLACE);
	    } else {
		Tcl_SetStartupScript(NewNativeObj(argv[3]), NULL);
	    }
	    argc -= 3;
	    i += 3;
	} else if ((argc >= 1) && ('-' != argv[1][0])) {
	    Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL);
	    argc--;
	    i++;
	}

Changes to tests/ioCmd.test.

472
473
474
475
476
477
478
479

480
481
482


483
484
485
486


487
488
489
490
491
492
493
472
473
474
475
476
477
478

479
480


481
482
483
484


485
486
487
488
489
490
491
492
493







-
+

-
-
+
+


-
-
+
+







} "1 unmatched open brace in list
unmatched open brace in list
    while processing open access modes \"FOO {BAR BAZ\"
    invoked from within
\"open \$path(test3) \"FOO \\{BAR BAZ\"\""
test iocmd-12.7 {POSIX open access modes: errors} {
  list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg
} {1 {invalid access mode "FOO": must be APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK, RDONLY, RDWR, TRUNC, or WRONLY}}
} {1 {invalid access mode "FOO": must be APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK, RDONLY, RDWR, REPLACE, STRICT, TCL8, TRUNC, or WRONLY}}
test iocmd-12.8 {POSIX open access modes: errors} {
    list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg
} {1 {access mode must include either RDONLY, RDWR, or WRONLY}}
    list [catch {open $path(test3) {BINARY STRICT}} msg] $msg
} {1 {invalid access mode "STRICT": modes BINARY, REPLACE, STRICT, and TCL8 cannot be combined}}
close [open $path(test3) w]
test iocmd-12.9 {POSIX open access modes: BINARY} {
    list [catch {open $path(test1) BINARY} msg] $msg
} {1 {access mode must include either RDONLY, RDWR, or WRONLY}}
    list [catch {open $path(test1) {RDWR WRONLY}} msg] $msg
} {1 {invalid access mode "WRONLY": modes RDONLY, RDWR, and WRONLY cannot be combined}}
test iocmd-12.10 {POSIX open access modes: BINARY} {
    set f [open $path(test1) {WRONLY BINARY TRUNC}]
    puts $f a
    puts $f b
    puts -nonewline $f c	;# contents are now 5 bytes: a\nb\nc
    close $f
    set f [open $path(test1) r]
514
515
516
517
518
519
520
521

522
523
524


525
526
527
528
529
530
531
514
515
516
517
518
519
520

521
522


523
524
525
526
527
528
529
530
531







-
+

-
-
+
+







    set result
} H
test iocmd-12.12 {POSIX open access modes: errors} {
  list [catch {open $path(test3) {RDWR WRONLY}} msg] $msg
} {1 {invalid access mode "WRONLY": modes RDONLY, RDWR, and WRONLY cannot be combined}}
test iocmd-12.13 {POSIX open access modes: errors} {
  list [catch {open $path(test3) {BINARY BINARY}} msg] $msg
} {1 {access mode "BINARY" repeated}}
} {1 {invalid access mode "BINARY": modes BINARY, REPLACE, STRICT, and TCL8 cannot be combined}}
test iocmd-12.14 {POSIX open access modes: errors} {
  list [catch {open $path(test3) {TRUNC}} msg] $msg
} {1 {access mode must include either RDONLY, RDWR, or WRONLY}}
  list [catch {open $path(test3) {TRUNC TRUNC}} msg] $msg
} {1 {access mode "TRUNC" repeated}}

test iocmd-13.1 {errors in open command} {
    list [catch {open} msg] $msg
} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
test iocmd-13.2 {errors in open command} {
    list [catch {open a b c d} msg] $msg
} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}