Tcl Source Code

Check-in [951cc4beed]
Login

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

Overview
Comment:Merge 9.0
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk | main
Files: files | file ages | folders
SHA3-256: 951cc4beedcf15c717d2382132dbedef3143f362fa37c1fc32aa10f83154a5b3
User & Date: jan.nijtmans 2025-06-26 11:15:59.086
Context
2025-06-26
13:46
Merge 9.0 Leaf check-in: 8f8b11907b user: jan.nijtmans tags: trunk, main
11:15
Merge 9.0 check-in: 951cc4beed user: jan.nijtmans tags: trunk, main
11:14
Make everthing compile (again) and run with a C++ compiler. check-in: aa010c0cda user: jan.nijtmans tags: core-9-0-branch
09:56
Merge 9.0 check-in: 52ff13f312 user: jan.nijtmans tags: trunk, main
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclBinary.c.
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *start, *cursor;
    int i, bits, index;
    unsigned int n;
    int lineLength = 61;
    const unsigned char SingleNewline[] = { UCHAR('\n') };
    const unsigned char *wrapchar = SingleNewline;
    Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }







|





|







2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *start, *cursor;
    int i, bits;
    unsigned int n;
    int lineLength = 61;
    const unsigned char SingleNewline[] = { UCHAR('\n') };
    const unsigned char *wrapchar = SingleNewline;
    Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR } index;
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"invalid wrapchar; will defeat decoding", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY",
			"ENCODE", "WRAPCHAR", (char *)NULL);
		return TCL_ERROR;
	    }
	    break;
	default:
	    TCL_UNREACHABLE();
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */







<
<







2798
2799
2800
2801
2802
2803
2804


2805
2806
2807
2808
2809
2810
2811
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"invalid wrapchar; will defeat decoding", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY",
			"ENCODE", "WRAPCHAR", (char *)NULL);
		return TCL_ERROR;
	    }
	    break;


	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */
Changes to generic/tclNamesp.c.
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const opts[] = {
	"-command", "-variable", NULL
    };
    int lookupType = 0;
    Tcl_Obj *resultPtr;

    if (objc < 2 || objc > 3) {
    badArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
	return TCL_ERROR;
    } else if (objc == 3) {







|







4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const opts[] = {
	"-command", "-variable", NULL
    };
    enum { OPT_COMMAND, OPT_VARIABLE } lookupType;
    Tcl_Obj *resultPtr;

    if (objc < 2 || objc > 3) {
    badArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
	return TCL_ERROR;
    } else if (objc == 3) {
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778

4779
4780
4781
4782
4783
4784
4785
4786
4787
4788

4789
4790
4791
4792
4793
4794
4795
	    Tcl_ResetResult(interp);
	    goto badArgs;
	}
    }

    TclNewObj(resultPtr);
    switch (lookupType) {
    case 0:;				/* -command */
	Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);

	if (cmd != NULL) {
	    Tcl_GetCommandFullName(interp, cmd, resultPtr);
	}
	break;

    case 1:;				/* -variable */
	Tcl_Var var = Tcl_FindNamespaceVar(interp,
		TclGetString(objv[objc-1]), NULL, /*flags*/ 0);

	if (var != NULL) {
	    Tcl_GetVariableFullName(interp, var, resultPtr);
	}
	break;
    default:
	TCL_UNREACHABLE();

    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|






>
|







<
<
>







4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787


4788
4789
4790
4791
4792
4793
4794
4795
	    Tcl_ResetResult(interp);
	    goto badArgs;
	}
    }

    TclNewObj(resultPtr);
    switch (lookupType) {
    case OPT_COMMAND: {
	Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);

	if (cmd != NULL) {
	    Tcl_GetCommandFullName(interp, cmd, resultPtr);
	}
	break;
    }
    case OPT_VARIABLE: {
	Tcl_Var var = Tcl_FindNamespaceVar(interp,
		TclGetString(objv[objc-1]), NULL, /*flags*/ 0);

	if (var != NULL) {
	    Tcl_GetVariableFullName(interp, var, resultPtr);
	}
	break;


    }
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
Changes to generic/tclTest.c.
37
38
39
40
41
42
43



44
45



46
47
48
49
50
51
52
#include "tclIO.h"

#include "tclUuid.h"

/*
 * Declare external functions used in Windows tests.
 */



DLLEXPORT int		Tcltest_Init(Tcl_Interp *interp);
DLLEXPORT int		Tcltest_SafeInit(Tcl_Interp *interp);




/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;







>
>
>


>
>
>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#include "tclIO.h"

#include "tclUuid.h"

/*
 * Declare external functions used in Windows tests.
 */
#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Tcltest_Init(Tcl_Interp *interp);
DLLEXPORT int		Tcltest_SafeInit(Tcl_Interp *interp);
#ifdef __cplusplus
}
#endif

/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
Changes to generic/tclThreadTest.c.
134
135
136
137
138
139
140



141



142
143
144
145
146
147
148
static void		ListUpdateInner(ThreadSpecificData *tsdPtr);
static int		ThreadEventProc(Tcl_Event *evPtr, int mask);
static void		ThreadErrorProc(Tcl_Interp *interp);
static void		ThreadFreeProc(void *clientData);
static int		ThreadDeleteEvent(Tcl_Event *eventPtr,
			    void *clientData);
static void		ThreadExitProc(void *clientData);



extern int		Tcltest_Init(Tcl_Interp *interp);




/*
 *----------------------------------------------------------------------
 *
 * TclThread_Init --
 *
 *	Initialize the test thread command.







>
>
>

>
>
>







134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
static void		ListUpdateInner(ThreadSpecificData *tsdPtr);
static int		ThreadEventProc(Tcl_Event *evPtr, int mask);
static void		ThreadErrorProc(Tcl_Interp *interp);
static void		ThreadFreeProc(void *clientData);
static int		ThreadDeleteEvent(Tcl_Event *eventPtr,
			    void *clientData);
static void		ThreadExitProc(void *clientData);
#ifdef __cplusplus
extern "C" {
#endif
extern int		Tcltest_Init(Tcl_Interp *interp);
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclThread_Init --
 *
 *	Initialize the test thread command.
Changes to unix/tclAppInit.c.
20
21
22
23
24
25
26



27
28



29
30
31
32
33
34
35
#  if TCL_MINOR_VERSION < 7
#   define Tcl_LibraryInitProc Tcl_PackageInitProc
#   define Tcl_StaticLibrary Tcl_StaticPackage
#  endif
#endif

#ifdef TCL_TEST



extern Tcl_LibraryInitProc Tcltest_Init;
extern Tcl_LibraryInitProc Tcltest_SafeInit;



#endif /* TCL_TEST */

#ifdef TCL_XT_TEST
extern void                XtToolkitInitialize(void);
extern Tcl_LibraryInitProc Tclxttest_Init;
#endif /* TCL_XT_TEST */








>
>
>


>
>
>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
#  if TCL_MINOR_VERSION < 7
#   define Tcl_LibraryInitProc Tcl_PackageInitProc
#   define Tcl_StaticLibrary Tcl_StaticPackage
#  endif
#endif

#ifdef TCL_TEST
#ifdef __cplusplus
extern "C" {
#endif
extern Tcl_LibraryInitProc Tcltest_Init;
extern Tcl_LibraryInitProc Tcltest_SafeInit;
#ifdef __cplusplus
}
#endif
#endif /* TCL_TEST */

#ifdef TCL_XT_TEST
extern void                XtToolkitInitialize(void);
extern Tcl_LibraryInitProc Tclxttest_Init;
#endif /* TCL_XT_TEST */

Changes to win/tclAppInit.c.
22
23
24
25
26
27
28



29
30



31
32
33
34
35
36
37
#  if TCL_MINOR_VERSION < 7
#   define Tcl_LibraryInitProc Tcl_PackageInitProc
#   define Tcl_StaticLibrary Tcl_StaticPackage
#  endif
#endif

#ifdef TCL_TEST



extern Tcl_LibraryInitProc Tcltest_Init;
extern Tcl_LibraryInitProc Tcltest_SafeInit;



#endif /* TCL_TEST */

#if defined(STATIC_BUILD)
extern Tcl_LibraryInitProc Registry_Init;
extern Tcl_LibraryInitProc Dde_Init;
extern Tcl_LibraryInitProc Dde_SafeInit;
#endif







>
>
>


>
>
>







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#  if TCL_MINOR_VERSION < 7
#   define Tcl_LibraryInitProc Tcl_PackageInitProc
#   define Tcl_StaticLibrary Tcl_StaticPackage
#  endif
#endif

#ifdef TCL_TEST
#ifdef __cplusplus
extern "C" {
#endif
extern Tcl_LibraryInitProc Tcltest_Init;
extern Tcl_LibraryInitProc Tcltest_SafeInit;
#ifdef __cplusplus
}
#endif
#endif /* TCL_TEST */

#if defined(STATIC_BUILD)
extern Tcl_LibraryInitProc Registry_Init;
extern Tcl_LibraryInitProc Dde_Init;
extern Tcl_LibraryInitProc Dde_SafeInit;
#endif