Tcl Source Code

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

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

Changes In Branch tip-641 Excluding Merge-Ins

This is equivalent to a diff from 4e9abffbc2 to c5259a44e4

2022-10-23
10:43
TIP #641: Let Tcl_GetBoolean(FromObj) handle (C99) bool check-in: 1fc0a86b2e user: jan.nijtmans tags: core-8-branch
2022-10-21
08:25
Merge 8.6 check-in: bbe81cdc01 user: jan.nijtmans tags: core-8-branch
2022-10-20
15:21
Merge 8.7 check-in: 61e4fe2b4e user: jan.nijtmans tags: bug-6978c01b65
15:18
Merge 8.7 Closed-Leaf check-in: c5259a44e4 user: jan.nijtmans tags: tip-641
15:16
Merge 8.7 Closed-Leaf check-in: 87ff3bbe46 user: jan.nijtmans tags: tip-643
15:15
Merge 8.7 check-in: c778e9043a user: jan.nijtmans tags: tip-646
2022-10-19
20:07
Merge 8.7 check-in: a4e82b6a98 user: jan.nijtmans tags: trunk, main
20:05
Re-build win64/zlib1.dll (with ucrt support) check-in: 4e9abffbc2 user: jan.nijtmans tags: core-8-branch
16:10
Merge 8.6 check-in: e7c14e904d user: jan.nijtmans tags: core-8-branch
2022-10-13
09:15
Merge 8.7 check-in: ca4b4056d3 user: jan.nijtmans tags: tip-641

Changes to doc/BoolObj.3.

16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44
45







-
+














-
+







.sp
Tcl_Obj *
\fBTcl_NewBooleanObj\fR(\fIintValue\fR)
.sp
\fBTcl_SetBooleanObj\fR(\fIobjPtr, intValue\fR)
.sp
int
\fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, intPtr\fR)
\fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, boolPtr\fR)
.sp
int
\fBTcl_GetBoolFromObj\fR(\fIinterp, objPtr, flags. charPtr\fR)
.SH ARGUMENTS
.AS Tcl_Interp intValue in/out
.AP int intValue in
Integer value to be stored as a boolean value in a Tcl_Obj.
.AP Tcl_Obj *objPtr in/out
Points to the Tcl_Obj in which to store, or from which to
retrieve a boolean value.
.AP Tcl_Interp *interp in/out
If a boolean value cannot be retrieved,
an error message is left in the interpreter's result value
unless \fIinterp\fR is NULL.
.AP int *intPtr out
.AP "bool \&| int" *boolPtr out
Points to place where \fBTcl_GetBooleanFromObj\fR
stores the boolean value (0 or 1) obtained from \fIobjPtr\fR.
.AP char *charPtr out
Points to place where \fBTcl_GetBoolFromObj\fR
stores the boolean value (0 or 1) obtained from \fIobjPtr\fR.
.AP int flags in
0 or TCL_NULL_OK. If TCL_NULL_OK
67
68
69
70
71
72
73
74

75
76
77
78


79
80

81
82
83
84
85
86
87
67
68
69
70
71
72
73

74
75
76


77
78
79

80
81
82
83
84
85
86
87







-
+


-
-
+
+

-
+







of \fIintValue\fR into \fI*objPtr\fR implies the freeing of
any former value stored in \fI*objPtr\fR.
.PP
\fBTcl_GetBooleanFromObj\fR attempts to retrieve a boolean value
from the value stored in \fI*objPtr\fR.
If \fIobjPtr\fR holds a string value recognized by \fBTcl_GetBoolean\fR,
then the recognized boolean value is written at the address given
by \fIintPtr\fR.
by \fIboolPtr\fR.
If \fIobjPtr\fR holds any value recognized as
a number by Tcl, then if that value is zero a 0 is written at
the address given by \fIintPtr\fR and if that
value is non-zero a 1 is written at the address given by \fIintPtr\fR.
the address given by \fIboolPtr\fR and if that
value is non-zero a 1 is written at the address given by \fIboolPtr\fR.
In all cases where a value is written at the address given
by \fIintPtr\fR, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR.
by \fIboolPtr\fR, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR.
If the value of \fIobjPtr\fR does not meet any of the conditions
above, then \fBTCL_ERROR\fR is returned and an error message is
left in the interpreter's result unless \fIinterp\fR is NULL.
\fBTcl_GetBooleanFromObj\fR may also make changes to the internal
fields of \fI*objPtr\fR so that future calls to
\fBTcl_GetBooleanFromObj\fR on the same \fIobjPtr\fR can be
performed more efficiently.

Changes to generic/tclDecls.h.

4330
4331
4332
4333
4334
4335
4336


4337
4338
4339
4340
4341
4342
4343
4344
4345
4346






4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359






4360
4361
4362
4363
4364
4365
4366
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380







+
+










+
+
+
+
+
+













+
+
+
+
+
+







#undef Tcl_GetUnicode
#define Tcl_GetString(objPtr) \
	Tcl_GetStringFromObj(objPtr, (int *)NULL)
#define Tcl_GetUnicode(objPtr) \
	Tcl_GetUnicodeFromObj(objPtr, (int *)NULL)
#undef Tcl_GetBytesFromObj
#undef Tcl_GetIndexFromObjStruct
#undef Tcl_GetBooleanFromObj
#undef Tcl_GetBoolean
#ifdef TCL_NO_DEPRECATED
#undef Tcl_GetStringFromObj
#undef Tcl_GetUnicodeFromObj
#undef Tcl_GetByteArrayFromObj
#endif
#if defined(USE_TCL_STUBS)
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(sizePtr)) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(sizePtr)))
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
	(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
	(sizeof(*(boolPtr)) == sizeof(int) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
	((sizeof(*(boolPtr)) == sizeof(char)) ? Tcl_GetBoolFromObj(interp, objPtr, 0, (char *)(boolPtr)) : (Tcl_Panic("Wrong bool var for %s", "Tcl_GetBooleanFromObj"), TCL_ERROR)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
	(sizeof(*(boolPtr)) == sizeof(int) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
	((sizeof(*(boolPtr)) == sizeof(char)) ? Tcl_GetBool(interp, src, 0, (char *)(boolPtr)) : (Tcl_Panic("Wrong bool var for %s", "Tcl_GetBoolean"), TCL_ERROR)))
#ifdef TCL_NO_DEPRECATED
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)(sizePtr)))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)(sizePtr)))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)(sizePtr)))
#endif
#else
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)(sizePtr)) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(sizePtr)))
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
	((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
	(sizeof(*(boolPtr)) == sizeof(int) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
	((sizeof(*(boolPtr)) == sizeof(char)) ? Tcl_GetBoolFromObj(interp, objPtr, 0, (char *)(boolPtr)) : (Tcl_Panic("Wrong bool var for %s", "Tcl_GetBooleanFromObj"), TCL_ERROR)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
	(sizeof(*(boolPtr)) == sizeof(int) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
	((sizeof(*(boolPtr)) == sizeof(char)) ? Tcl_GetBool(interp, src, 0, (char *)(boolPtr)) : (Tcl_Panic("Wrong bool var for %s", "Tcl_GetBoolean"), TCL_ERROR)))
#ifdef TCL_NO_DEPRECATED
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)(sizePtr)) : (TclGetStringFromObj)(objPtr, (size_t *)(sizePtr)))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)(sizePtr)) : TclGetByteArrayFromObj(objPtr, (size_t *)(sizePtr)))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)(sizePtr)) : TclGetUnicodeFromObj(objPtr, (size_t *)(sizePtr)))

Changes to generic/tclTest.c.

29
30
31
32
33
34
35

36
37
38
39
40
41
42
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43







+







#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif
#include "tclOO.h"
#include <math.h>
#include <stdbool.h>

/*
 * Required for Testregexp*Cmd
 */
#include "tclRegexp.h"

/*
2328
2329
2330
2331
2332
2333
2334
2335

2336
2337
2338
2339
2340
2341
2342
2329
2330
2331
2332
2333
2334
2335

2336
2337
2338
2339
2340
2341
2342
2343







-
+







    TCL_UNUSED(int) /*flags*/)
{
    TestEvent *ev = (TestEvent *) event;
    Tcl_Interp *interp = ev->interp;
    Tcl_Obj *command = ev->command;
    int result = Tcl_EvalObjEx(interp, command,
	    TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
    int retval;
    bool retval;

    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"    (command bound to \"testevent\" callback)");
	Tcl_BackgroundException(interp, TCL_ERROR);
	return 1;		/* Avoid looping on errors */
    }
2900
2901
2902
2903
2904
2905
2906
2907


2908
2909
2910
2911
2912
2913
2914
2901
2902
2903
2904
2905
2906
2907

2908
2909
2910
2911
2912
2913
2914
2915
2916







-
+
+







    static unsigned int uintVar = 0xBEEFFEED;
    static long longVar = 123456789L;
    static unsigned long ulongVar = 3456789012UL;
    static float floatVar = 4.5;
    static Tcl_WideUInt uwideVar = 123;
    static int created = 0;
    char buffer[2*TCL_DOUBLE_SPACE];
    int writable, flag;
    bool writable;
    int flag;
    Tcl_Obj *tmp;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg arg arg arg arg arg arg arg arg arg arg"
		" arg arg?\"", NULL);
	return TCL_ERROR;
5533
5534
5535
5536
5537
5538
5539
5540


5541
5542
5543
5544
5545
5546
5547
5535
5536
5537
5538
5539
5540
5541

5542
5543
5544
5545
5546
5547
5548
5549
5550







-
+
+







TestsaveresultCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Interp* iPtr = (Interp*) interp;
    int discard, result, index;
    int result, index;
    bool discard;
    Tcl_SavedResult state;
    Tcl_Obj *objPtr;
    static const char *const optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {
	RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL
6518
6519
6520
6521
6522
6523
6524
6525

6526
6527
6528
6529
6530
6531
6532
6521
6522
6523
6524
6525
6526
6527

6528
6529
6530
6531
6532
6533
6534
6535







-
+







    }
    cmdName = argv[1];
    len = strlen(cmdName);

    if ((cmdName[0] == 't') && (strncmp(cmdName, "testflags", len) == 0)) {
        Tcl_Channel hChannel;
        int modePtr;
        int testMode;
        bool testMode;
        TcpState *statePtr;
        /* Set test value in the socket driver
         */
        /* Check for argument "channel name"
         */
        if (argc < 4) {
            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6742
6743
6744
6745
6746
6747
6748
6749


6750
6751
6752
6753
6754
6755
6756
6745
6746
6747
6748
6749
6750
6751

6752
6753
6754
6755
6756
6757
6758
6759
6760







-
+
+







static int
TestFilesystemObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int res, boolVal;
    int res;
    bool boolVal;
    const char *msg;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
7113
7114
7115
7116
7117
7118
7119
7120


7121
7122
7123
7124
7125
7126
7127
7117
7118
7119
7120
7121
7122
7123

7124
7125
7126
7127
7128
7129
7130
7131
7132







-
+
+







static int
TestSimpleFilesystemObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int res, boolVal;
    int res;
    bool boolVal;
    const char *msg;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {

Changes to generic/tclTestObj.c.

20
21
22
23
24
25
26

27
28
29
30
31
32
33
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34







+







#include "tclInt.h"
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif
#include "tclStringRep.h"
#include <stdbool.h>

#ifdef __GNUC__
/*
 * The rest of this file shouldn't warn about deprecated functions; they're
 * there because we intend them to be so and know that this file is OK to
 * touch those fields.
 */
349
350
351
352
353
354
355
356

357
358
359
360
361
362
363
350
351
352
353
354
355
356

357
358
359
360
361
362
363
364







-
+







TestbooleanobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t varIndex;
    int boolValue;
    bool boolValue;
    const char *subCmd;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;

Changes to win/tclWinSock.c.

1195
1196
1197
1198
1199
1200
1201
1202
1203


1204
1205
1206
1207
1208
1209
1210

1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225


1226
1227
1228
1229
1230
1231
1232

1233
1234
1235
1236
1237
1238
1239
1195
1196
1197
1198
1199
1200
1201


1202
1203
1204
1205
1206
1207

1208

1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222


1223
1224
1225
1226
1227
1228

1229

1230
1231
1232
1233
1234
1235
1236
1237







-
-
+
+




-

-
+













-
-
+
+




-

-
+







	return TCL_ERROR;
    }

    sock = statePtr->sockets->fd;

    if ((len > 1) && (optionName[1] == 'k') &&
	    (strncmp(optionName, "-keepalive", len) == 0)) {
	BOOL val;
	int boolVar, rtn;
	BOOL boolVar;
	int rtn;

	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
	    return TCL_ERROR;
	}
	val = boolVar ? TRUE : FALSE;
	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
		(const char *) &val, sizeof(BOOL));
		(const char *) &boolVar, sizeof(boolVar));
	if (rtn != 0) {
	    Tcl_WinConvertError(WSAGetLastError());
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set socket option: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if ((len > 1) && (optionName[1] == 'n') &&
	(strncmp(optionName, "-nodelay", len) == 0)) {
	BOOL val;
	int boolVar, rtn;
	BOOL boolVar;
	int rtn;

	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
	    return TCL_ERROR;
	}
	val = boolVar ? TRUE : FALSE;
	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
		(const char *) &val, sizeof(BOOL));
		(const char *) &boolVar, sizeof(boolVar));
	if (rtn != 0) {
	    Tcl_WinConvertError(WSAGetLastError());
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set socket option: %s",
			Tcl_PosixError(interp)));
	    }