Tcl Source Code

Changes On Branch tip-677
Login

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

Changes In Branch tip-677 Excluding Merge-Ins

This is equivalent to a diff from b88bac358d to 5c5ebda098

2023-12-01
16:22
We're doing TDD here! Leaf check-in: 5c5ebda098 user: dkf tags: tip-677
2023-11-29
14:26
Start of tests check-in: 1032092431 user: dkf tags: tip-677
2023-11-26
22:21
Fix [a606b0a528]: Tcl 9.0 fails to build from source for big-endian architectures check-in: 7af5aa4277 user: jan.nijtmans tags: trunk, main
2023-11-25
15:08
Merge main into tip-677 check-in: 6cb29772da user: dkf tags: tip-677
2023-11-24
15:58
Experimental: update automatic build instructions check-in: b88bac358d user: dkf tags: trunk, main
14:38
Merge 8.7 check-in: 56e92002a8 user: jan.nijtmans tags: trunk, main
12:50
Simpler to use an existing action check-in: 51b3fe2a67 user: dkf tags: update-onfiledist

Added doc/const.n.







































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
'\"
'\" Copyright (c) 2023 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH const n 9.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
const \- create and initialize a constant
.SH SYNOPSIS
\fBconst \fIvarName value\fR
.BE
.SH DESCRIPTION
.PP
This command is normally used within a procedure body (or method body, 
or lambda term) to create a constant within that procedure, or within a 
\fBnamespace eval\fR body to create a constant within that namespace. 
The constant is an unmodifiable variable, called \fIvarName\fR, that is 
initialized with \fIvalue\fR.
.PP
If a variable \fIvarName\fR does not exist, it is created.
If the variable already exists, it is set to \fIvalue\fR.
The variable is marked as a constant; this means that no other command
(e.g., \fBset\fR, \fBappend\fR, \fBincr\fR, \fBunset\fR)
may modify or remove the variable; variables are checked for whether they 
are constants before any traces are called.
.PP
The \fIvarName\fR may not be a qualified name or reference an element of an 
array by any means. If the variable exists and is an array, that is an error.
.PP
Constants are normally only removed by their containing procedure exiting or 
their namespace being deleted.
.SH EXAMPLES
.PP
Create a constant in a procedure:
.PP
.CS
proc foo {a b} {
    \fBconst\fR BAR 12345
    return [expr {$a + $b + $BAR}]
}
.CE
.PP
Create a constant in a namespace to factor out a regular expression:
.PP
.CS
namespace eval someNS {
    \fBconst\fR FOO_MATCHER {(?i)}\emfoo\eM}

    proc findFoos str {
        variable FOO_MATCHER
        regexp -all $FOO_MATCHER $str
    }

    proc findFooIndices str {
        variable FOO_MATCHER
        regexp -all -indices $FOO_MATCHER $str
    }
}
.CE
.PP
Making a constant in a loop doesn't error:
.PP
.CS
proc foo {n} {
    set result {}
    for {set i 0} {$i < $n} {incr i} {
        \fBconst\fR X 123
	lappend result [expr {$X + $i**2}]
    }
}
.CE
.SH "SEE ALSO"
proc(n), namespace(n), set(n), unset(n)
.SH KEYWORDS
namespace, procedure, variable, constant
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to generic/tclBasic.c.

312
313
314
315
316
317
318

319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},

    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroinject",	NULL,			NULL,                   TclNRCoroInjectObjCmd,	CMD_IS_SAFE},
    {"coroprobe",	NULL,			NULL,                   TclNRCoroProbeObjCmd,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
    {"fpclassify",      FloatClassifyObjCmd,    NULL,                   NULL,   CMD_IS_SAFE},
    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
    {"ledit",		Tcl_LeditObjCmd,	NULL,	NULL,	CMD_IS_SAFE},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},







>

















|







312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"const", 		Tcl_ConstObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroinject",	NULL,			NULL,                   TclNRCoroInjectObjCmd,	CMD_IS_SAFE},
    {"coroprobe",	NULL,			NULL,                   TclNRCoroProbeObjCmd,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
    {"fpclassify",      FloatClassifyObjCmd,    NULL,                   NULL,   CMD_IS_SAFE},
    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
    {"ledit",		Tcl_LeditObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},

Changes to generic/tclInt.h.

657
658
659
660
661
662
663





664
665
666
667
668
669
670
 * VAR_LINK -			1 means this Var structure contains a pointer
 *				to another Var structure that either has the
 *				real value or is itself another VAR_LINK
 *				pointer. Variables like this come about
 *				through "upvar" and "global" commands, or
 *				through references to variables in enclosing
 *				namespaces.





 *
 * Flags that indicate the type and status of storage; none is set for
 * compiled local variables (Var structs).
 *
 * VAR_IN_HASHTABLE -		1 means this variable is in a hash table and
 *				the Var structure is malloc'ed. 0 if it is a
 *				local variable that was assigned a slot in a







>
>
>
>
>







657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
 * VAR_LINK -			1 means this Var structure contains a pointer
 *				to another Var structure that either has the
 *				real value or is itself another VAR_LINK
 *				pointer. Variables like this come about
 *				through "upvar" and "global" commands, or
 *				through references to variables in enclosing
 *				namespaces.
 * VAR_CONSTANT -		1 means this is a constant "variable", and 
 *				cannot be written to by ordinary commands. 
 *				Structurally, it's the same as a scalar when
 *				being read, but writes are rejected. Constants
 *				are not supported inside arrays.
 *
 * Flags that indicate the type and status of storage; none is set for
 * compiled local variables (Var structs).
 *
 * VAR_IN_HASHTABLE -		1 means this variable is in a hash table and
 *				the Var structure is malloc'ed. 0 if it is a
 *				local variable that was assigned a slot in a
721
722
723
724
725
726
727

728
729
730
731
732
733
734
 * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values
 * in precompiled scripts keep working.
 */

/* Type of value (0 is scalar) */
#define VAR_ARRAY		0x1
#define VAR_LINK		0x2


/* Type of storage (0 is compiled local) */
#define VAR_IN_HASHTABLE	0x4
#define VAR_DEAD_HASH		0x8
#define VAR_ARRAY_ELEMENT	0x1000
#define VAR_NAMESPACE_VAR	0x80	/* KEEP OLD VALUE for Itcl */








>







726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
 * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values
 * in precompiled scripts keep working.
 */

/* Type of value (0 is scalar) */
#define VAR_ARRAY		0x1
#define VAR_LINK		0x2
#define VAR_CONSTANT		0x10000

/* Type of storage (0 is compiled local) */
#define VAR_IN_HASHTABLE	0x4
#define VAR_DEAD_HASH		0x8
#define VAR_ARRAY_ELEMENT	0x1000
#define VAR_NAMESPACE_VAR	0x80	/* KEEP OLD VALUE for Itcl */

755
756
757
758
759
760
761

762
763
764
765
766
767
768
769
770
771
772
773
774
775



776
777
778
779
780
781
782
783
784
785
786
787
/*
 * Macros to ensure that various flag bits are set properly for variables.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclSetVarScalar(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarArray(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarLink(Var *varPtr);

 * MODULE_SCOPE void	TclSetVarArrayElement(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarUndefined(Var *varPtr);
 * MODULE_SCOPE void	TclClearVarUndefined(Var *varPtr);
 */

#define TclSetVarScalar(varPtr) \
    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK)

#define TclSetVarArray(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY

#define TclSetVarLink(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK




#define TclSetVarArrayElement(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT

#define TclSetVarUndefined(varPtr) \
    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\
    (varPtr)->value.objPtr = NULL

#define TclClearVarUndefined(varPtr)

#define TclSetVarTraceActive(varPtr) \
    (varPtr)->flags |= VAR_TRACE_ACTIVE








>






|







>
>
>




|







761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
/*
 * Macros to ensure that various flag bits are set properly for variables.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclSetVarScalar(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarArray(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarLink(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarConstant(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarArrayElement(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarUndefined(Var *varPtr);
 * MODULE_SCOPE void	TclClearVarUndefined(Var *varPtr);
 */

#define TclSetVarScalar(varPtr) \
    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT)

#define TclSetVarArray(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY

#define TclSetVarLink(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK

#define TclSetVarConstant(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_CONSTANT

#define TclSetVarArrayElement(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT

#define TclSetVarUndefined(varPtr) \
    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT);\
    (varPtr)->value.objPtr = NULL

#define TclClearVarUndefined(varPtr)

#define TclSetVarTraceActive(varPtr) \
    (varPtr)->flags |= VAR_TRACE_ACTIVE

805
806
807
808
809
810
811

812
813
814
815
816
817
818
    }

/*
 * Macros to read various flag bits of variables.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE int	TclIsVarScalar(Var *varPtr);

 * MODULE_SCOPE int	TclIsVarLink(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArray(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarUndefined(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArrayElement(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarTemporary(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArgument(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarResolved(Var *varPtr);







>







815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
    }

/*
 * Macros to read various flag bits of variables.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE int	TclIsVarScalar(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarConstant(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarLink(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArray(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarUndefined(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArrayElement(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarTemporary(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArgument(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarResolved(Var *varPtr);
831
832
833
834
835
836
837




838
839
840
841
842
843
844

#define TclIsVarLink(varPtr) \
    ((varPtr)->flags & VAR_LINK)

#define TclIsVarArray(varPtr) \
    ((varPtr)->flags & VAR_ARRAY)





#define TclIsVarUndefined(varPtr) \
    ((varPtr)->value.objPtr == NULL)

#define TclIsVarArrayElement(varPtr) \
    ((varPtr)->flags & VAR_ARRAY_ELEMENT)

#define TclIsVarNamespaceVar(varPtr) \







>
>
>
>







842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859

#define TclIsVarLink(varPtr) \
    ((varPtr)->flags & VAR_LINK)

#define TclIsVarArray(varPtr) \
    ((varPtr)->flags & VAR_ARRAY)

/* Implies scalar as well. */
#define TclIsVarConstant(varPtr) \
    ((varPtr)->flags & VAR_CONSTANT)

#define TclIsVarUndefined(varPtr) \
    ((varPtr)->value.objPtr == NULL)

#define TclIsVarArrayElement(varPtr) \
    ((varPtr)->flags & VAR_ARRAY_ELEMENT)

#define TclIsVarNamespaceVar(varPtr) \
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
                && (TclVarParentArray(varPtr)->flags & (trickyFlags))))

#define TclIsVarDirectReadable(varPtr)					\
    (   (!TclIsVarTricky(varPtr,VAR_TRACED_READ))			\
          && (varPtr)->value.objPtr)

#define TclIsVarDirectWritable(varPtr) \
    (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH))

#define TclIsVarDirectUnsettable(varPtr) \
    (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH))

#define TclIsVarDirectModifyable(varPtr) \
    (   (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE))	\
          &&  (varPtr)->value.objPtr)

#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
    (TclIsVarDirectReadable(varPtr) &&\
	(!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))

#define TclIsVarDirectWritable2(varPtr, arrayPtr) \







|


|


|







905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
                && (TclVarParentArray(varPtr)->flags & (trickyFlags))))

#define TclIsVarDirectReadable(varPtr)					\
    (   (!TclIsVarTricky(varPtr,VAR_TRACED_READ))			\
          && (varPtr)->value.objPtr)

#define TclIsVarDirectWritable(varPtr) \
    (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT))

#define TclIsVarDirectUnsettable(varPtr) \
    (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT))

#define TclIsVarDirectModifyable(varPtr) \
    (   (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT))	\
          &&  (varPtr)->value.objPtr)

#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
    (TclIsVarDirectReadable(varPtr) &&\
	(!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))

#define TclIsVarDirectWritable2(varPtr, arrayPtr) \
3639
3640
3641
3642
3643
3644
3645

3646
3647
3648
3649
3650
3651
3652
MODULE_SCOPE Tcl_ObjCmdProc TclChanPostEventObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPopObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPushObjCmd;
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd;

MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd;
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    void *clientData);
MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd;
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,







>







3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
MODULE_SCOPE Tcl_ObjCmdProc TclChanPostEventObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPopObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPushObjCmd;
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd;
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    void *clientData);
MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd;
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,

Changes to generic/tclVar.c.

124
125
126
127
128
129
130

131
132
133
134
135
136
137
	"upvar refers to element in deleted array";
static const char DANGLINGVAR[] =
	"upvar refers to variable in deleted namespace";
static const char BADNAMESPACE[] =	"parent namespace doesn't exist";
static const char MISSINGNAME[] =	"missing variable name";
static const char ISARRAYELEMENT[] =
	"name refers to an element in an array";


/*
 * A test to see if we are in a call frame that has local variables. This is
 * true if we are inside a procedure body.
 */

#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)







>







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
	"upvar refers to element in deleted array";
static const char DANGLINGVAR[] =
	"upvar refers to variable in deleted namespace";
static const char BADNAMESPACE[] =	"parent namespace doesn't exist";
static const char MISSINGNAME[] =	"missing variable name";
static const char ISARRAYELEMENT[] =
	"name refers to an element in an array";
static const char ISCONST[] =		"variable is a constant";

/*
 * A test to see if we are in a call frame that has local variables. This is
 * true if we are inside a procedure body.
 */

#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
1936
1937
1938
1939
1940
1941
1942











1943
1944
1945
1946
1947
1948
1949
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			DANGLINGVAR, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", (void *)NULL);
	    }
	}
	goto earlyError;
    }












    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {







>
>
>
>
>
>
>
>
>
>
>







1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			DANGLINGVAR, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", (void *)NULL);
	    }
	}
	goto earlyError;
    }

    /*
     * It's an error to try to set a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	}
	goto earlyError;
    }

    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
2216
2217
2218
2219
2220
2221
2222











2223
2224
2225
2226
2227
2228
2229
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Tcl_Obj *varValuePtr;












    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }
    varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
	    part2Ptr, flags, index);
    if (TclIsVarInHash(varPtr)) {







>
>
>
>
>
>
>
>
>
>
>







2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Tcl_Obj *varValuePtr;

    /*
     * It's an error to try to increment a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	}
	return NULL;
    }

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }
    varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
	    part2Ptr, flags, index);
    if (TclIsVarInHash(varPtr)) {
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448











2449
2450
2451
2452
2453
2454
2455
 *----------------------------------------------------------------------
 */

int
TclPtrUnsetVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    Var *varPtr,	/* The variable to be unset. */
    Var *arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags,		/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Interp *iPtr = (Interp *) interp;
    int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
    Var *initialArrayPtr = arrayPtr;












    /*
     * Keep the variable alive until we're done with it. We used to
     * increase/decrease the refCount for each operation, making it hard to
     * find [Bug 735335] - caused by unsetting the variable whose value was
     * the variable's name.
     */







|






|









>
>
>
>
>
>
>
>
>
>
>







2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
 *----------------------------------------------------------------------
 */

int
TclPtrUnsetVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    Var *varPtr,		/* The variable to be unset. */
    Var *arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags,			/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Interp *iPtr = (Interp *) interp;
    int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
    Var *initialArrayPtr = arrayPtr;

    /*
     * It's an error to try to unset a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (void *)NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Keep the variable alive until we're done with it. We used to
     * increase/decrease the refCount for each operation, making it hard to
     * find [Bug 735335] - caused by unsetting the variable whose value was
     * the variable's name.
     */
4800
4801
4802
4803
4804
4805
4806


















































4807
4808
4809
4810
4811
4812
4813

	if (index < iPtr->varFramePtr->numCompiledLocals) {
	    namePtr = localName(iPtr->varFramePtr, index);
	    Tcl_AppendObjToObj(objPtr, namePtr);
	}
    }
}



















































/*
 *----------------------------------------------------------------------
 *
 * Tcl_GlobalObjCmd --
 *
 *	This object-based function is invoked to process the "global" Tcl







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897

	if (index < iPtr->varFramePtr->numCompiledLocals) {
	    namePtr = localName(iPtr->varFramePtr, index);
	    Tcl_AppendObjToObj(objPtr, namePtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConstObjCmd --
 * 
 *	This function is invoked to process the "const" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result value.
 *
 * Side effects:
 *	See the user documentation.
 * 
 *----------------------------------------------------------------------
 */

int
Tcl_ConstObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName value");
	return TCL_ERROR;
    }

    varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, 
	    "const", /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
    if (arrayPtr) {
	// FIXME: What if we got an array?
    }
    if (!varPtr->value.objPtr) {
	if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL, 
		objv[2], TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	};
	varPtr->flags |= VAR_CONSTANT;
	return TCL_OK;
    }

    /* FIXME: implement this! */
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("not yet implemented"));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GlobalObjCmd --
 *
 *	This object-based function is invoked to process the "global" Tcl

Changes to tests/var.test.

1476
1477
1478
1479
1480
1481
1482
























































































1483
1484
1485
1486
1487
1488
1489
test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob

























































































catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob

# The const command
test var-25.1 {const: no argument} -body {
    apply {{} {
	const
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.2 {const: single argument} -body {
    apply {{} {
	const X
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.3 {const: two arguments (basic correct usage)} {
    apply {{} {
	const X gorp
	return $X
    }}
} gorp
test var-25.4 {const: three arguments} -body {
    apply {{} {
	const X gorp foo
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.5 {const: four arguments} -body {
    apply {{} {
	const X gorp foo bar
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}

test var-26.1 {const: unmodifiable by set} -body {
    apply {{} {
	const X 123
	set X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.2 {const: unmodifiable by append} -body {
    apply {{} {
	const X 123
	append X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.3 {const: unmodifiable by lappend} -body {
    apply {{} {
	const X 123
	lappend X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.4 {const: unmodifiable by incr} -body {
    apply {{} {
	const X 123
	incr X
    }}
} -returnCodes error -result {can't incr "X": variable is a constant}
test var-26.5 {const: unmodifiable by dict set} -body {
    apply {{} {
	const X {a 123}
	dict set X a gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.6 {const: unmodifiable by regsub} -body {
    apply {{} {
	const X abcabc
	regsub -all {a(.)} $X {\1\1} X
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.7 {const: unmodifiable by gets} -setup {
    set file [makeFile foo var26.7.txt]
    set f [open $file]
} -body {
    apply {f {
	const X abcabc
	gets $f X
    }} $f
} -returnCodes error -cleanup {
    close $f
    removeFile $file
} -result {can't set "X": variable is a constant}
test var-26.8 {const: modifiable by const} knownBug {
    apply {{} {
	const X 1
	const X 2
	return $X
    }}
} 2

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}